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ABSTRACT 


A  shell  formulation  was  developed  from  a  three-dimensional  solid.  The  shell 
element  has  four  comer  nodes  at  which  there  are  three  displacements  and  three  rotations  as 
nodal  degrees  of  freedom,  and  includes  both  transverse  shear  and  transverse  normal 
deformations.  The  element  utilizes  reduced  integration  along  the  in-plane  axes  and  full 
integration  along  the  transverse  axis.  The  formulation  incorporates  the  Gurson  constitutive 
model  for  void  growth  and  plastic  deformation.  An  algorithm  for  stable  solutions  of  the 
nonlinear  constitutive  equations  is  also  developed.  Hourglass  mode  control  is  provided  by 
adding  a  small  fraction  of  internal  force  determined  through  full  integration  along  the  in¬ 
plane  axes  and  reduced  integration  along  the  transverse  axis.  Implementation  into  both  a 
specialized  research  finite  element  program  and  DYSMAS,  a  derivative  of  DYNA3D,  is 
discussed.  Numerical  examples  are  provided  to  verify  the  accuracy  of  the  new  element  and 
to  show  the  importance  of  the  transverse  normal  stress,  void  effects  on  plastic  strain,  and  the 
necessity  of  applying  a  drilling  moment. 
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I.  INTRODUCTION 


Since  shell  structures  are  efficient  load-carrying  structural  members,  they  have  been 
dominant  in  most  structural  applications.  However,  the  finite  element  formulation  of  shells 
poses  some  difficulty.  As  a  result,  extensive  study  has  been  devoted  to  developing  better 
shell  elements.  Because  of  the  abundance  of  papers  on  this  subject,  no  attempt  is  made  here 
to  summarize  all  of  them.  Some  of  the  related  past  work  is  given  in  references  [1-12]. 

Void  growth  and  nucleation  can  have  a  significant  effect  on  plastic  flow  [13].  Since 
voids  act  as  stress  concentrators,  the  overall  effect  is  to  reduce  the  stress  under  plastic  flow, 
and  increase  the  plastic  strain  [14-16].  The  model  proposed  by  Gurson  appears  to  have  been 
adopted  as  the  standard  for  incorporating  void  growth  and  nucleation  effects  into  a  numerical 
solution  of  elasto-plastic  problems  [17].  Previous  work  has  been  done  on  improving  the 
efficiency  and  accuracy  of  plasticity  computations,  applying  plasticity  to  plate/shell 
elements,  and  incorporating  void  growth  and  nucleation  effects  in  solid  elements  [18-20]. 
The  element  presented  in  this  paper  incorporates  a  modified  version  of  the  algorithm  for 
three-dimensional  solids  proposed  by  Aravas  [21]  into  a  shell  element.  This  shell  element 
assumes  a  modified  plane-stress  condition,  and  utilizes  both  the  hydrostatic  pressure  and  the 
deviatric  stress.  Due  to  the  importance  of  the  hydrostatic  pressure  on  void  growth  and 
nucleation,  this  element  includes  the  transverse  normal  stress. 

The  algorithm  proposed  by  Aravas  is  not  unconditionally  stable  when  applied  to  this 
modified  plane  stress  condition  [21].  This  paper  also  presents  modifications  to  the  original 
algorithm,  which  greatly  enhance  the  stability  of  the  solution,  at  the  cost  of  a  slight  decrease 
in  computational  efficiency.  This  algorithm  also  allows  for  more  complicated  work- 
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hardening  profiles  than  the  typical  exponent  law  (a  =  Ks").  Full  modeling  of  the  entire 
stress-strain  curve  is  accomplished  by  a  piece-wise  linear  approximation.  While  this  method 
is  not  particularly  useful  for  analytic  approaches,  it  appears  to  be  helpful  in  strictly  numerical 
solutions.  The  stress-strain  relationship  may  be  taken  directly  off  the  results  of  a  standard 
tensile  test. 

For  thick  shell  applications,  the  transverse  normal  stress  and  strain  cannot  be 
neglected.  The  transverse  normal  stress  and  strain  affect  both  the  hydrostatic  pressure  and 
the  deviatoric  stress,  which  in  turn  affect  plastic  deformation  and  void  growth  and 
nucleation.  The  element  presented  here  extends  the  typical  use  of  the  drilling  degree  of 
freedom  (DOF),  as  outlined  in  Hughes  and  Brezzi  [22],  to  incorporate  the  effects  of 
transverse  normal  strain.  The  drilling  DOF  is  important  in  transmitting  stress  and  strain  to 
elements  across  sharp  bends  and  curves,  and  is  therefore  already  included  in  a  variety  of  shell 
elements  [2,4,6,7,10].  In  addition  to  this  traditional  usage,  the  present  element  utilizes  the 
drilling  DOF  to  compute  the  transverse  normal  deformation.  The  importance  of  including 
the  transverse  normal  deformation  is  outlined  in  Essenburg  [23]. 

The  present  study  formulates  a  shell  element  for  transient  analysis.  The  element  can 
have  elasto-plastic  deformation  with  void  growth  and  nucleation.  Gurson's  void  model  is 
used  as  a  basis  for  the  void  constitutive  model.  The  shell  element  includes  both  transverse 
shear  deformation  and  the  transverse  normal  deformation  for  thick  shell  applications.  The 
drilling  degree  of  freedom  is  used  for  computing  the  deformation  through  the  thickness  of 
a  thick  shell.  An  algorithm  for  stable  solutions  of  the  nonlinear  constitutive  equations  is  also 
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developed. 

Some  example  problems  are  presented  to  evaluate  the  formulation  and  to  investigate 
the  effects  of  the  transverse  normal  strain  for  thick  shells  in  association  with  elasto-plastic 
deformation,  including  void  effects.  Implementation  and  verification  for  DYSMAS  is  then 
discussed. 
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II.  FINITE  ELEMENT  FORMULATION 


A.  GEOMETRY 

A  point  in  a  shell  structure  can  be  expressed  by  a  vector  sum  of  two  vectors.  The  first 
vector  is  a  position  vector  from  the  origin  of  the  global  coordinate  system  to  a  point  on  a 
reference  surface  of  the  shell  element.  The  second  vector  is  a  position  vector  from  this 
reference  surface  to  the  point  under  consideration.  The  surface  that  spans  the  center  of  the 
transverse  axis  is  used  as  the  reference  surface  in  this  formulation,  although  any  surface 
would  suffice.  The  first  vector  terminates  at  the  reference  surface  directly  below  the  point 
in  question.  The  second  vector  is  then  the  normal  from  the  reference  surface  that  intersects 
the  desired  point.  Figure  1  shows  this  relationship.  Two  shape  functions  are  used  to  describe 


Origin 

Figure  1.  Element  Cross  Section. 
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a  position  in  the  element;  is  the  two  dimensional  shape  function  in  the  ^-r\  plane,  and 
Hk  is  the  one  dimensional  shape  function  along  the  £  axis,  where  (^,r\,Q  describes  a  point 
in  the  natural  coordinate  system.  A  generic  point  in  the  shell  may  now  be  described  in  terms 
of  the  position  vectors  of  the  nodes  and  the  shape  functions: 

=  X,  +fJNt(4,n)Ht(()vi  (i  =  1,2,3)  (1) 

k=l  *= 1 


where  xl  is  the  position  vector  of  node  k  in  the  reference  surface;  J 7k3i  is  the  unit  vector  at 
the  node  k;  and  n  is  the  number  of  nodes  per  element.  In  the  present  formulation,  a  four-node 
shell  element  is  considered.  The  unit  vector  vi  is  defined  as: 

k  (xf.r-cxf)**" 

3'  |(xf)'op  -(xf)Ao"on'|  U 

where  top  and  bottom  indicate  the  top  and  bottom  surfaces  of  the  shell,  and  ||  ||  denotes  the 
Euclidean  norm.  The  one-dimensional  shape  function  is  expressed  as: 


Hk(0  = 


(X*)'”  -(X,*) 


k  \  bottom 


(3) 


in  which  C,  indicates  the  location  of  the  reference  surface  and  varied  from  -1  to  1(^  =  0 
denotes  the  mid-surface).  The  two-dimensional  shape  function  N&  is  expressed  as: 

N'-ia-ZHl-rj) 

N2  =  i(l+4)(1-Tj) 

N3=i(i+Z)0+v)  } 

N4-i(i-Z)(i+v) 
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B.  DISPLACEMENT 


The  displacement  field  in  a  shell  can  be  written  as: 
n  n 

u,(Z,V,t)  =  X  Nk(^V)u^+  X  Nk(Z,V)Hk(O(-VkA+Vkne\  +  Vk3i0k3)  (i  =  1,2,3)  (5) 

k=l  k=l 

in  which  uj  is  the  displacement  along  the  xj  axis,  ul  is  the  nodal  displacement  at  the  node 
and  unit  vectors  V/,-  and  Vk2i  lie  along  the  reference  surface.  Vn ,  V%  and  yk3i  are  mutually 
perpendicular.  q\  ,  Qk  and  q\  are  rotational  degrees  of  freedom  along  the  unit  vectors 
Vn,Vk2i  and Vk3i,  respectively.  The  right-hand  rule  is  assumed  for  the  positive  direction  of 
each  rotation.  Figure  2  illustrates  the  relationship  among  these  vectors. 


Figure  2.  Displacement  Vector  Orientation. 
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g)  and  0k2  are  the  bending  rotations,  while  g\  is  the  drilling  rotational  degree  of 
freedom.  The  role  of  g\  can  be  clarified  by  considering  a  flat  plate  parallel  to  the  xj-%2 
plane.  Now  Eq.  (5)  can  be  rewritten  for  the  transverse  displacement  as: 

u3=J]Nkuk3  +YjNkHkgk  (6) 

k=\  k=\ 

Equation  (6)  demonstrates  that  the  transverse  deformation  varies  through  the  plate  thickness 
(i.e.  along  the  £  axis)  with  6k .  In  this  way,  the  transverse  normal  deformation  is  included 
in  this  formulation,  along  with  the  transverse  shear  deformations. 

C.  COORDINATE  TRANSFORMATION 

Combining  the  three  unit  direction  vectors  into  matrix  [Tp]  provides  the  rotation 
transformation  matrix,  or  matrix  of  direction  cosines,  as  shown  in  Eq.  (7).  [Tp]_1  is  used  to 
transform  the  nodal  degrees  of  freedom  from  the  global  coordinate  system  to  local 
coordinates,  as  shown  in  Eq.  (8),  where  k  is  the  node  number.  The  components  of  {d}  at  the 
four  nodes  of  an  element  are  shown  in  Eq.  (9).  Once  the  internal  force  vector  is  generated 
in  local  coordinates,  [Tp]  is  used  to  transform  the  local  vectors  back  into  global  coordinates. 
This  procedure  will  be  discussed  later. 

[TpHViV2V3|(3x3)  (7) 
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{dk}(6xl) 


1 

0 

0 

0 

0 

0 

0 

1 

0 

0 

0 

0 

0 

0 

1 

0 

0 

0 

0 

0 

0 

0 

0 

0 

[tT 

0 

0 

0 

{ dgiobai  Ln  ^  ~  ^  >2,3,4) 


{d}={d’d2d3d4}T  (9) 

The  strain  transformation  matrix,  [T],  is  used  to  transform  calculated  strain  from  the 
global  coordinate  system  to  local  coordinates.  Transforming  the  resulting  stress  from  local 
coordinates  to  the  global  coordinate  system  would  normally  require  using  [T]'1,  but  since  [T] 
is  orthogonal,  [T] =  [T] T,  where  [T] T  is  the  transpose  of  [T].  This  property  negates  the 
requirement  to  invert  a  six  by  six  matrix.  For  a  detailed  derivation  of  these  transformations, 
refer  to  Cook  [24].  The  strain  transformation  matrix  is  explicitly  defined  in  Eq.  (10),  where 
Vjj  is  the  cosine  of  the  direction  vector  V;  in  the  xj  direction. 
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V12  V23  V22  v,3 

V,3V21  +  V23V„ 

V3, 

2  V22  V32 

2V23V33 

V2,V32  +  V3,V22 

V22V33"*"  V32V23 

V23V3,  +  V33V2, 

V3, 

2  V,2  V32 

2v,3v33 

V„V32  +  V3,V,2 

V,2V33  +  V32V,3 

V^Vs,"**  V33V,,. 
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D.  STRAIN  DISPLACEMENT  RELATION 

The  six  components  of  the  strain  tensor  are  computed  from  Eq.  (5)  by  taking  its 
derivative  with  respect  to  the  xj  axis.  In  matrix  form,  the  result  for  a  four-node  element  is: 

M-MW  (ii) 

kh(ensnajr,ir13r„  Y  (12) 

where 

[B]=[[B']M[B’M  (13) 

The  detailed  expression  for  [Bk]  is: 


[b‘]= 


~dNk 

Sx, 

0 

0 

-g,Vk2, 

gi  v)i 

gk,vii 

0 

ML 

3x2 

0 

-g\Vk22 

g\vkl2 

g\Vk32 

0 

0 

ML 

8x3 

-g\Vk23 

g\Vn 

g\  V33 

dNk 

8xi 

ml 

3x1 

0 

-gtyv-g^ 

g\Vku 

+  gjVl2 

g\  V31 

+  gkVk32 

0 

ml 

3xi 

8Nk 

3X2 

-g\Vk22-g\Vk23 

g\Vkl2 

+  g\VkI3 

g\Vk32 

+  glVk33 

dNk 

.3X3 

0 

3Nk 

3xi 

-g\Vk21-g\Vk23 

g\Vku 

+gkjV% 

g\v\i 

+  gjVk33 

(14) 


in  which 


g, 


dxi 


OXi 


The  vector  {cfe  }  is  defined  as: 


{/}={ 


uj  u\  Us  0)  0k2  03  } 


(15) 


(16) 
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where  uj  is  the  displacement  along  the  Xj  direction  at  node  k.  and  Q,  is  the  rotational 
displacement  about  the  xj  axis  at  node  k.  The  matrix  [Bk]  must  be  calculated  for  each 
integration  point. 

E.  JACOBIAN  MATRIX 


Computing  the  derivatives  and  requires  the  Jacobian  matrix,  defined  as 


where 


Xl,%  X2£  X34 

X  Irj  X  2.j]  X  5.77 

Xl£  X24  X}£ 


Sx,_±dNt  . 


x«  *  £  «  *  +  2  aTflV'  <»-«« 

og  k=I  og  *=/  og 


“V  k=l  STJ  k=l  STJ 


xa=^7='LNt^-Vk,l  fi- 1,2,3)  (20) 

.  SC  £1  sc 

m  is  defined  as  the  inverse  of  the  Jacobian  matrix,  [J  '].  Then  the  required  partial 
derivatives  are  defined  as: 


+  o-w) 

og  or] 

(21) 

;  ft  Tjk 

-  =  Ri3^r  0  =  12,3) 

SC 

(22) 
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G.  DRILLING  MOMENTS 

Let  mj  be  the  transverse  deflection  as  defined  in  Eq.  (6).  The  work  done  by  a 
pressure  loading,  p,  on  an  element  is: 
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(27) 


W  =  J^u3  p  dA 

where  Ae  is  the  element  area.  Substituting  Eq.  (6)  into  Eq.  (27),  the  work  is  now: 

w  =  { #,  F  l  [N]p  flW  +  { S,  f  l  [n‘h‘  ]  P  dA  (28) 

The  first  term  gives  the  conventional  forces  at  each  node,  while  the  second  term  yields  the 
new  nodal  load,  which  will  be  called  the  Drilling  Moment  (DM).  For  example,  if  p  is  a 
concentrated  force  P  at  node  n,  then  the  drilling  moment  associated  with  03”  becomes 
/2£tP,  where  t  is  the  shell  thickness  and  the  mid-plane  is  the  reference  plane. 

When  P  is  applied  at  the  top  plane,  C,  equals  one,  and  the  drilling  moment  is  ]/2tP . 
If  P  is  applied  at  the  bottom  plane  (still  with  a  positive  loading  direction),  the  drilling 
moment  is  -  X  tP .  That  is,  the  load  results  in  compression  or  tension  in  the  transverse 
normal  stress  depending  on  whether  the  loading  is  applied  to  the  top  or  bottom  surface  of  the 
shell.  The  transverse  normal  stress  is  assumed  constant  through  the  shell  thickness  for  elastic 
deformation.  However,  as  plastic  deformation  progresses,  the  transverse  normal  stress 
becomes  non-uniform  through  the  thickness  in  order  to  satisfy  the  yield  function. 

The  drilling  moment  direction  coincides  with  the  direction  of  drilling  rotation,  but 
affects  the  transverse  normal  stress.  The  drilling  moment  is  used  as  a  mathematical 
convenience,  and  thus,  lacks  a  physical  interpretation. 
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H.  INTERNAL  FORCE,  MASS  AND  THEIR  ASSEMBLY 


The  stress  resulting  from  Eq.  (25)  is  then  converted  to  an  internal  force  vector  and 
summed  over  all  integration  points  using 

( 1  *  nx  ny  nz 

{  f im}=  \  J  J  \&Y  {(J}&Z&V&£  =  'Yj  X  X  [B]T  {<?  }wi  WjWk|  J  |  (29) 

-1  -7  ./  i=l  j=l  k=l 

where  |  J  |  is  the  determinant  of  the  Jacobian  matrix,  nx,  ny,  and  nz  are  the  number  of 


integration  points  in  the  £  %  and  £  directions,  respectively,  and  wj,  wj,  and  wfc,  are  the  Gauss 
weights  related  to  those  integration  points.  The  resulting  force  vector,  { fjM  } ,  must  have  its 
components  transformed  back  to  the  global  coordinate  system  using: 


1 

0 

0 

0 

0 

0 

0 

1 

0 

0 

0 

0 

0 

0 

1 

0 

0 

0 

0 

0 

0 

0 

0 

0 

w 

0 

0 

0 

(fS»U  (k  =  l, 2,3,4) 


(30) 


A  lumped  mass  method  is  used  for  the  element  mass  matrix.  The  matrix  for  each 
element  is  diagonal,  with  equal  diagonal  elements: 


me  0  0  ... 

0  me  0  — 


[M,]= 


0  0 


me 


0 

0 

0 


0  0 


(31) 
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where 


nx  ny  nz 

2  2  2  Wi  WJ Wk 

i=l  j=l  k-I 

n 

with  n  =  4  in  this  four-node  element.  Using  a  diagonal  mass  matrix  greatly  simplifies  time 
integration,  since  inverting  it  is  a  trivial  task  requiring  little  computation  time.  The  internal 
force  vector  and  element  mass  vector  (each  24  by  1)  are  then  assembled  into  the 
corresponding  system  vectors. 

I.  EXPLICIT  TIME  INTEGRATION 

The  use  of  internal  force  vectors  and  explicit  time  integration  negates  the  need  to 
explicitly  form  the  system  stiffness  matrices.  The  acceleration  vector  is  computed  from 

[0}  =  [M]-'  ({  Fex,  }'  -  {  Fin,  }' )  (33) 

where  [u  }  is  the  system  acceleration  vector,  [M]  is  the  system  mass  matrix,  { Fex, }  is  the 
system  external  force  vector,  and  superscript  t  denotes  the  time  step.  Of  course,  the  system 
mass  matrix  in  Eq.  (33)  is  simply  symbolic,  since  a  system  mass  vector,  formed  from  the 
diagonal  of  the  mass  matrix,  is  used  in  actual  computation.  Velocity  and  displacement  are 
then  found  using 

.  {tfr-w-'+w*  (34) 

{u]+Al  =  {u}'  +  {[/}'+f  At 
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III.  DAMAGE  CONSTITUTIVE  EQUATIONS 


A.  GURSON’S  VOID  MODEL 

Yielding  and  plastic  deformation  in  the  element  follows  the  model  proposed  by 
Gurson  for  symmetric  deformations  around  a  spherical  void  [17].  The  yielding  condition  is 

F  =  f— 1  +  2^<Dcoshf--^l  -  {l  +  q3®2)=0  (35) 

^ Go)  V  2  Go 

• where  (Pis  the  current  porosity, p  is  the  hydrostatic  stress,  q  is  the  effective  stress,  and  g<> 
is  the  current  yield  stress.  This  model  assumes  equivalent  yield  stress  in  both  tension  and 
compression.  The  constants  q],  q2,  and  q]  were  introduced  by  Tvergaard  in  order  to  provide 
a  better  match  with  numerical  studies  [16].  Aravas  provides  a  detailed  explanation  of 
implementing  this  model  in  a  static  finite  element  algorithm  for  three-dimensional  solid 
elements  [21].  The  procedure  used  here  is  essentially  the  same,  with  some  modifications  due 
to  the  different  element  formulation.  The  stress  is  then  transformed  to  local  coordinates,  and 
the  internal  force  vector  is  computed  as  described  above.  One  thing  to  be  noted  in  Eq.  (35) 
is  that  if  0  is  initially  0,  the  yielding  criteria  surface  is  identical  to  the  von  Mises  yield 
condition. 

After  calculating  the  strain  tensor  using  Eq.  (23),  any  previous  plastic  strain  is 
subtracted  using 

{^}={fto,o/}- {fp}  (36) 
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The  stress  is  then  calculated  using  Eq.  (24)  with  the  components  of  {se  }■  Using  these 
values,  the  hydrostatic  stress,  deviatoric  stress  and  effective  stress  are  calculated  as  follows: 

P  =  i-(  (7  XX  +  CTyy  +  CT;z  )  (37) 

{s}={a}+p{5}  (38) 


where  <5"  is  the  Kronecker  delta  function: 


{^}= {moo}7’  (40) 

At  this  point,  F  is  calculated  from  Eq.  (35).  If  F  is  greater  than  zero,  indicating  plastic  flow, 
iteration  is  required  to  determine  the  new  porosity  and  change  in  plastic  strain.  The 
predictor-corrector  method  used  in  Aravas  [21]  is  also  used  here.  Using  the  values  of p  and 
q  previously  calculated  as  a  first  guess,  correction  factors  are  calculated  using 

{C/}=[A]-{A1}  (41) 

where 


and 


(44) 
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AO 


nuc  l  nation  " 


_  OjV 


Sn 


exp; 


Sn 


V 


v  Sn  J 


As, 


(50) 


where  0]\r  is  the  volume  fraction  of  void  nucleating  particles  and  sN  and  sN  are  the  mean  and 
standard  deviation  of  a  normal  distribution  of  nucleation  strain,  as  suggested  by  Chu  and 
Needleman  [15]  and  utilized  by  Aravas  [21].  Then  the  effective  plastic  strain,  and  void 
content  are  updated  with 


A  o--PAsP  + 

*  (1-0  )  (To 


(51) 


sf+&l  =  sf  +  As” 


(52) 


where  sf  is  the  effective  plastic  strain  from  the  previous  time  step.  At  this  point,  the  change 
in  yield  stress  due  to  strain  hardening  is  calculated  (see  below).  If  either  a  or  /?  is  greater 
than  a  predetermined  tolerance,  the  process  iterates  beginning  with  Eq.  (41).  The  tolerance 
used  for  all  examples  presented  in  the  paper  is  1 .0  x  10-4. 


B.  IMPROVING  STABILITY  IN  THE  CONSTITUTIVE  EQUATIONS 

Stability  in  the  procedure  outlined  above  is  very  dependent  on  the  order  in  which  the 
various  equations  are  evaluated.  Aravas  discusses  the  stability  problem  when  considering 
problems  involving  large  plastic  strains  [21].  While  the  change  in  plastic  strain  from  one 
time  step  to  the  next  will  theoretically  be  small,  high  strain  rate  and  changes  in  the  strain¬ 
hardening  characteristics  of  the  material  act  to  degrade  stability.  Equations  (42),  (43)  and 
(45)  are  not  complete  in  that  they  do  not  contain  all  of  the  derivative  terms  required  by  the 
chain  rule. 
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The  predictor-corrector  method  used  is  based  on  Newton's  method,  where  the 
correction  factors,  a  and  (3,  are  found  from 


where 


f,ur  fu 
fi 


2,Ae„ 


\a\ 

[P\ 


If*. 


(53) 


/,= 


rj_  ^ 

\a0 J 


+  2^,0  cosh  — — — 1  -  (l  +  g302 ) 
V  2oro  J 


(54) 


f2=ASrMi+AsJL 

J2  p  dq  q  dp 


(55) 


f  __  K  df\  ,  dfi  80  ,  8f\  dcro 
XMp  dp  50  dA£p  da0  dAsp 


(56) 


f  3Gdfl  i  ^  50  i  dcr° 

dq  50  dAsq  da0  dAsq 


(57) 


A 


2,Asp 


d2/,  d&o 

p  da0dq  dAsp 


+  ^  ALM 
dq  ~ 


Kd2fx  |  d2fx  50  |  52/j  5cr0 
dp2  dpd<S>  dAs  dpda0  dAs 


p  J 


/2 


=  f+A£* 


52/,  50  |  52/;  5cr0 
dpd<t>  5As?  dpda0  dAsc 


+  A  s. 


3Gd 2 A  |  &fi  d<Tp 


dq  dqdcr0  5Af 


?  J 


(58) 


(59) 


Derivative  terms  that  are  zero  have  been  dropped,  and  K  and  G  are  the  bulk  and  shear 


moduli,  respectively,  fj  is  Gurson's  void  function,  and  f2  is  the  flow  mle,  both  of  which  are 
driven  to  zero.  As  void  content  increases,  the  number  of  iterations  required  to  achieve 
convergence  increases  dramatically,  and  often  diverges,  instead.  By  removing  all  partial 
derivatives  relating  to  void  content,  the  stability  of  the  algorithm  is  greatly  increased,  at  the 
cost  of  only  2  to  3  extra  iterations,  depending  on  the  current  void  content.  The  dependence 
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on  the  current  yield  stress  is  retained  to  allow  convergence  across  a  transition  in  the  slope  of 
the  yield  stress  versus  strain  relationship. 

The  partial  derivatives  of  yield  stress  with  respect  to  Asp  and  Asq  are  computed  by 
calculating  the  slope  from  the  current  yield  stress  to  the  yield  stress  corresponding  to  the 
increase  in  plastic  strain  from  the  corrected  values  of  Asp  and  Asq.  This  means  that  these 
derivatives  will  be  zero  on  the  first  iteration,  since  both  of  the  control  variables  are  initialized 
to  zero.  Several  error  traps  must  be  included  to  prevent  round-off  and  truncation  error  from 
causing  the  algorithm  to  diverge,  and  to  prevent  porosity  from  decreasing  or  becoming 
negative.  One  of  the  assumptions  used  in  this  implementation  is  that  once  voids  form,  they 
do  not  disappear.  In  other  words,  voids  do  not  disappear  when  the  element  is  placed  in 
compression. 

C.  STRAIN  HARDENING 

Modeling  the  nonlinear  elasto-plastic  behavior  of  the  material  used  is  simplified  by 
constructing  a  piece-wise  linear  version  of  the  stress-strain  plot.  Using  the  tangent  modulus. 
Ex,  for  each  piece-wise  region,  the  yield  stress  is  calculated  with 

<?o+a,  =  (t$  +  En ( £i  -  Si-i)  +  Etj ( ef  -  Sj.i )  (60) 

;  =  / 

where  cro+A/  is  the  yield  stress  for  this  time  step,  cr°  is  the  original  yield  stress,  sf  is  the 
total  effective  strain  for  the  time  step  under  consideration,  and  s,  is  the  upper  strain  limit  of 
the  zth  linear  segment,  so  is  the  original  yield  strain,  and  is  calculated  by  the  program  as 
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simply  crl/E .  The  current  effective  elastic  strain  is  calculated  by  dividing  the  current  yield 
stress  by  the  elastic  modulus,  E.  This  is  added  to  the  current  effective  plastic  strain  to  obtain 
the  total  effective  strain. 

As  an  example,  let  the  total  effective  strain  from  Eq.  (49)  lie  within  the  second  work¬ 
hardening  segment.  The  new  yield  stress  is 

o-o+A'  =  cr0°  +  En(et  -  so)  +  En ( ef\M  -  Si )  (61) 

Figure  3  illustrates  this  example.  The  algorithm  calculates  the  new  yield  stress  as  a  function 
of  the  cumulative  effective  plastic  strain,  the  current  effective  elastic  strain,  and  the  original 
yield  stress  for  each  iteration  of  the  damage  constitutive  equations. 


Figure  3.  Calculating  a  New  Yield  Stress. 
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rv.  HOURGLASS  MODE  CONTROL 


Only  one  integration  point  is  used  in  each  plane  parallel  to  the  reference  plane,  which 
results  in  under-integration  in  the  %-rj  plane.  This  leads  to  spurious,  hourglass,  or  zero- 
energy  modes  in  the  element,  which  will  yield  useless  results  if  left  uncontrolled.  The  effects 
of  these  modes  are  shown  in  Fig.  4,  a  pinched  cylinder  where  one  eighth  of  the  structure  is 
modeled  by  utilizing  symmetry  boundary  conditions.  Clearly,  no  useful  information  can  be 
obtained  from  the  resulting  solution. 


Figure  4.  Hourglass  Modes  in  a  Pinched  Cylinder  Model. 
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Belytschko,  et  al.,  proposed  an  efficient  means  of  controlling  the  hourglass  modes 
of  a  similar  element  [25].  The  method  described  uses  a  portion  of  a  stiffness  matrix 
generated  by  full  integration  in  all  directions  to  modify  the  stiffness  matrix  generated  by 
under-integration.  Although  the  formulation  proposed  in  this  paper  does  not  use  a  stiffness 
matrix,  a  similar  approach  is  just  as  effective  in  controlling  these  modes. 

Rather  than  fully  integrating  in  all  three  directions,  the  element  is  fully  integrated  in 
the  £-77  plane,  but  under-integrated  in  the  £  direction,  as  shown  in  Fig.  5.  The  procedure 
described  above  for  calculating  the  internal  force  vector  is  followed  to  generate  an  internal 
force  vector  related  to  these  four  integration  points. 


Figure  5.  Hourglass  Mode  Control  Integration  Points. 

The  algorithm  for  calculating  strain,  stress,  and  force  for  the  hourglass  mode  control 
integration  points  is  identical  to  the  algorithm  used  to  produce  the  main  internal  force  vector, 


with  the  exception  of  plastic  strain.  The  damage  constitutive  equations  described  in  the 
previous  section  are  not  utilized  for  hourglass  mode  control.  The  internal  forces  generated 
from  the  two  integration  schemes  are  treated  like  the  stiffness  matrices  in  Belytschko  et  al. 
[25].  For  nz  integration  points  through  the  element  thickness,  the  new  force  vector  is 

{/„}={/“"}  +  M/w)  (62) 

where 

{/*j={ /,r }-{/«"“}  .  («) 

and 

h  =  —  (64) 

A 

The  variable  h  is  used  here  in  Eqs.  (62)  and  (64)  instead  of  the  fused  in  Belytschko 
et  al.  [25],  to  avoid  confusion  with  the  various  strains  discussed  in  this  paper.  The  variables 
used  to  calculate  h  are  the  element  thickness  (/)  and  the  element’s  surface  area  (A).  The 
effect  of  r  follows  that  described  in  Belytschko  et  al.  [25],  and  is  set  to  0.05.  The  range  of 
values  for  r  that  effectively  controls  the  hourglass  modes,  but  does  not  greatly  affect  the 
overall  element  stiffness  is  roughly  0.046  to  0.057  (determined  experimentally).  Since  the 
elements  are  in  arbitrary  orientation  in  3-D  space,  the  area  calculation  is  computed  as  the 
sum  of  the  area  of  the  two  triangles  formed  by  dividing  the  element  at  the  diagonal  between 
nodes  one  and  three: 

-  Di  +  lA  -  Dl  (65) 

where 
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.  Di  fa\  -  X}  )  (3Cj  -  Xj  )  +  (x2  -  x2 )  (x2  ~  x2 )  +  (x3  -  x3 )  (x2  -  x3 ) 
D2  -  (x\  -  *,4 )  (x\  -xf)  +  (x\  -  x2 )  (x\  -x\  )  +  (x\  -  x\  )  (x\ 3  -  x3 ) 


(66) 


(67) 


and  (xf,**,** )  is  the  location  of  node  £  in  the  global  coordinate  system.  For  these 


calculations,  the  element  is  assumed  to  be  flat  (no  curvature  along  either  the  £  or  77 
directions).  The  effectiveness  of  this  method  of  control  is  shown  in  Fig.  6,  the  same  problem 
as  shown  in  Fig.  4,  but  with  the  hourglass  mode  control  described  above. 


Figure  6.  Pinched  Cylinder  Model  with  Hourglass  Mode  Control. 
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All  verification  problems  analyzed  in  the  following  section  were  completed  with 
hourglass  control  enabled.  The  current  implementation  uses  hourglass  control  consistently, 
but  allows  easy  modification  to  make  hourglass  control  a  user-defined  option.  The  internal 
hourglass  mode  control  can  be  disabled  when  the  element  is  used  in  a  general  finite  element 
program  that  includes  various  methods  of  spurious  mode  control. 
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VL  NUMERICAL  EXAMPLES 


The  element  presented  here  has  been  extensively  tested  using  a  variety  of  problems 
in  which  an  analytic  solution  was  available,  and  has  produced  satisfactory  results  in  all  cases 
studied.  The  transformation  matrices  and  constitutive  equations  were  verified  with 
specifically  tailored  problems,  and  the  element  passes  the  patch  test.  The  examples  presented 
below  are  representative  of  the  test  cases  used  to  verify  the  element,  and  are  presented  in  the 
order  of  curvature:  flat,  singly  curved,  and  doubly  curved.  For  each  case,  an  elastic  solution 
is  compared  to  available  results,  and  then  the  elasto-plastic  solutions  are  presented. 
Examples  A  through  I  were  solved  using  a  locally  written,  research  oriented  finite  element 
program  in  conjunction  with  a  locally  developed  preprocessor  and  postprocessor. 

A.  ELASTIC  PLATE 

A  plate  clamped  on  all  four  sides  is  subjected  to  a  concentrated  force  at  its  center. 
The  elastic  modulus  is  10  Msi  (68.95  GPa),  the  density  is  0.1647  slugs/in3  (0.147  kg/cm3), 
and  Poisson=s  ratio  is  0.2.  The  dimensions  of  the  plate  are  10  in  x  10  in  x  0.1  in  thick 
(25.4cm  x  25.4  cm  x  0.254  cm).  The  yield  stress  is  set  high  enough  to  ensure  a  completely 
elastic  response.  Two  integration  points  through  the  thickness  are  used.  The  applied  force 
is  40  lbf  (177.9  N).  The  finite  element  mesh  uses  symmetry  to  model  one  quarter  of  the 
plate,  with  appropriate  symmetry  boundary  conditions  applied.  Both  a  2x2  (4  element)  and 
4x4  (16  element)  mesh  are  used  in  the  finite  element  analysis.  The  results  for  both  meshes 
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and  the  analytic  solution  are  shown  in  Table  1.  Using  a  four-element  mesh,  the  new  shell 
element  obtained  a  displacement  within  3.27%  of  the  analytic  solution,  and  0.82%  using  a 
16  element  mesh. 


Table  1.  Comparison  of  Results  for  Elastic  Clamped  Plate. 


Analysis  Type 

Center  Node  Peak  Displacement  (in) 

2  x  2  FE  Mesh  (Dynamic) . 

-4.74xl0'2 

4  x  4  FE  Mesh  (Dynamic) 

-4.94x1 0‘2 

Analytic  (Twice  the  Static  Solution) 

-4.90xl0'2 

B.  THICK  CLAMPED  PLATE  UNDER  PRESSURE  LOAD  IN  ELASTO- 

PLASTIC  REGION 


A  thick  steel  plate,  clamped  on  all  four  sides,  is  subjected  to  dynamic  pressure  load. 
The  plate  is  6m  by  6m  by  0.6m  thick  (for  a  10:1  ratio).  Table  2  shows  the  material 
properties  for  the  structure.  Table  3  shows  the  properties  for  the  void  model. 


Table  2.  Material  Properties  of  Clamped  Plate. 


Property 

Value 

Units 

Elastic  Modulus  (E) 

2x10" 

Pa 

Tangent  Modulus  (Er) 

2xl010 

Pa 

Density  (p) 

7850 

kg/m3 

Poisson's  ratio  (v) 

0.29 

(none) 

Yield  Stress  (Syp) 

2.5x10s 

Pa 

Table  3.  Void  Characteristics  of  Clamped  Plate. 


Initial  Void  Content  (<t>0) 

0.0 

Nucleating  Particle  Content  (<t>N) 

0.04 

Mean  Nucleation  Strain  (e^ 

0.3 

Nucleation  Strain  Standard  Deviation  (sN) 

0.1 

Model  Constant  q, 

1.5 

Model  Constant 

1.0 

Model  Constant  q3  (  =  q,2) 

2.25 
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One  quarter  of  the  plate  is  modeled  with  a  three  by  three  element  mesh,  for  a  total  of 
nine  elements,  with  appropriate  symmetry  boundary  conditions  applied,  and  is  shown  below 
in  Fig.  8. 


Figure  7.  Nine  Element  Clamped  Plate  Mesh. 

Four  integration  points  are  used  through  the  thickness  of  each  element.  The 
calculation  time  step  is  10'5  seconds,  while  the  data  is  plotted  at  2xl04  second  increments. 
The  analysis  terminates  at  0.04  seconds.  The  plate  is  subjected  to  a  uniformly  distributed 
pressure  acting  downwards,  and  includes  the  appropriate  drilling  moment.  The  pressure 
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increases  linearly  from  0.0  Pa  at  the  start  to  80  MPa  at  0.01  seconds,  then  remains  constant 
for  the  duration  of  the  analysis.  Three  cases  were  analyzed:  no  void  effects,  void  growth 
effects  only,  and  void  growth  and  nucleation.  Figure  9  illustrates  the  effect  of  voids  on  the 
effective  stress  versus  the  effective  strain  relationship  in  the  top  of  one  of  the  border 
elements.  When  void  effects  are  not  included,  the  Von-Mises  Equivalent  (VME)  stress 
follows  the  yield  stress  in  the  plastic  region  (See  Fig.  9a). 

Including  void  effects  causes  the  yielding  before  the  VME  stress  reaches  the  yield 
stress.  As  the  void  content  increases  with  continued  plastic  flow,  the  VME  stress  falls  farther 
below  the  yield  stress,  as  shown  in  Fig.  9b  (see  Eq.  (35)).  Table  4  summarizes  the  results 
of  the  three  cases.  The  most  significant  difference  is  in  the  transverse  normal  stress, 

This  difference  resulted  in  a  2.0%  increase  in  the  effective  plastic  strain,  and  a  2.6%  increase 
in  the  peak  deflection  of  the  center  of  the  plate. 

Another  interesting  point  is  that  the  transverse  normal  stress  was  compressive  and 
constant  throughout  the  thickness  up  until  plastic  flow,  as  assumed  in  the  formulation,  then 
varied  as  the  stress  in  the  bottom  fiber  decreased  and  became  tensile.  Figure  10  shows  the 
variation  of  transverse  normal  stress  through  the  thickness  of  the  element  at  the  time  of  peak 
stress.  Eventually,  the  transverse  normal  stress  varied  from  compressive  at  the  top,  where 
the  pressure  was  applied,  and  tensile  at  the  bottom.  The  examples  that  follow  will  not 
include  a  separate  analysis  for  void  growth  effects  only,  since  the  difference  of  including 
nucleation  effects  at  the  resulting  small  plastic  strains  obtained  do  not  cause  significantly 
different  results.  • 
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Effective  Stress 


Effective  Strain 


Figure  8.  Void  Effects  in  a  Clamped  Plate  with  Pressure  Loading:  Top  (a)  -  No  Void 
Effects,  Bottom  (b)  -  Void  Effects. 
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Table  4.  Summary  of  Results  for  Clamped  Plate  with  Pressure  Load. 


Peak  Values  for  Element  #3 

No  Void  Effects 

Void  Growth 

Growth  and  Nucleation 

Ovm  (Gpa) 

1.4498 

1.3789 

1.3784 

^effective 

0.0588 

0.0597 

0.0597 

<*xx  (GPa) 

1.4501 

1.3603 

1.3598 

<?w  (GPa) 

0.6561 

0.6030 

0.6073 

(GPa) 

(Max  Tension) 

-0.0003 

0.0065 

0.0091 

Czz  (GPa) 

(Max  Compression) 

-0.0363 

-0.0322 

-0.0320 

splastic  (effective) 

0.0540 

0.0551 

0.0551 

<t>  (Porosity) 

NA 

0.0355 

0.0357 

Deflection  (m) 

(Center  Node) 

-0.3801 

-0.3897 

-0.3898 

C.  THICK  CLAMPED  PLATE  WITH  CENTRAL  POINT  LOAD  IN  THE 

ELASTO-PLASTIC  REGION 

The  geometry  and  material  properties  of  this  example  are  identical  to  those  used  in 
the  previous  example.  The  pressure  load  has  been  replaced  with  a  point  load  at  the  center 
node.  Four  cases  are  studied:  without  void  effects  or  a  drilling  moment,  with  void  effects, 
with  a  drilling  moment  applied,  and  with  both  void  effects  and  a  drilling  moment  applied. 
All  four  sides  are  clamped,  and  the  center  node  displacement  is  restricted  in  the  x  and  y 
directions.  Then,  a  DM  equal  to  the  applied  force  times  one-half  the  plate  thickness  is 
applied  for  both  the  no- void  and  void  cases.  The  time  history  of  the  stress  components  in  the 
center  element  is  shown  in  Fig.  10,  and  the  relationship  between  porosity  and  effective 
plastic  strain  is  illustrated  in  Fig.  1 1 .  The  results  for  all  four  cases  are  summarized  in  Table 
5. 
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Table  5.  Summary  of  Results  for  Clamped  Plate  Subjected  to  Point  Force. 


Peak  Values  for  Center 
Element 

No  Voids 

No  DM 

No  Voids 
Drilling  Moment 

Voids 

Drilling  Moment 

ctvm  (GPa) 

2.1119 

1.9021 

2.0540 

1.8590 

^effective 

0.0892 

0.0929 

0.0865 

0.0887 

crx*  (GPa) 

2.0008 

1.8407 

2.0000 

1.7498 

CTw  (GPa) 

1.9588 

1.7245 

1.8589 

1.7234 

cra  (GPa) 

(Max  Tension) 

0.0048 

0.0213 

-0.0003 

-0.0003 

<J»  (GPa) 

(Max  Compression) 

-0.0036 

-0.0057 

-0.1751 

-0.1691 

^plastic  (effective) 

0.0838 

0.0880 

0.0812 

0.0840 

®  (Porosity) 

NA 

0.0663 

NA 

0.0601 

Deflection  (m) 

(Center  Node) 

-0.4413 

-0.4544 

-0.4350 

-0.4451 

The  drilling  moment  increases  the  effective  stress  on  the  fiber  in  compression,  and 
decreases  the  effective  stress  on  the  fiber  in  tension.  The  reduction  in  the  tensile  stress 
results  in  a  reduction  in  the  effective  plastic  strain.  Including  void  effects  decreases  the 
VME  stress  on  the  fiber  in  tension,  and  slightly  increases  the  VME  stress  on  the  fiber  in 
compression.  The  effective  plastic  strain  is  also  increased.  All  of  these  results  indicate  that 
this  formulation  correctly  predicts,  in  a  qualitative  sense,  the  effects  of  drilling  moments  and 
void  growth  and  nucleation.  Including  only  void  effects  increased  the  effective  plastic  strain 
by  5.0%,  while  including  only  the  drilling  moment  decreased  the  effective  plastic  strain  by 
3.1%.  Including  both  void  effects  and  the  drilling  moment  increased  the  effective  plastic 
strain  by  0.2%,  indicating  the  importance  of  applying  both  effects  together. 


D.  SIMPLY  SUPPORTED  PLATE  WITH  CENTRAL  POINT  LOAD  IN  THE 

ELASTO-PLASTIC  REGION 


The  material  properties,  geometry,  mesh,  and  time  values  from  the  clamped  plate 
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problem  above  are  used  here.  The  magnitude  of  the  force  is  8x10s  N,  and  the  drilling 
moment,  when  applied,  is  -2.4x1 0s  N.  The  same  four  cases  are  analyzed:  no  void  or 
drilling  moment  effects,  drilling  moment  effects  only,  void  effects  only,  and  both  void 
and  drilling  moment  effects.  The  analysis  results  for  all  four  cases  are  summarized  in 
Table  6. 


Table  6.  Summary  of  Results  for  a  Simply  Supported  Plate  with  a  Point  Force. 


Peak  Values  for  Center 
Element 

No  Voids 
No  DM 

No  Voids 
Drilling  Moment 

Voids 

No  DM 

Voids  and 
Drilling  Moment 

ctvm  (GPa) 

3.0874 

3.0089 

2.5061 

2.4881 

^effective 

0.1360 

0.1321 

0.1450 

0.1393 

(GPa) 

3.0253 

2.9123 

2.4686 

2.4206 

ctvv  (GPa) 

3.0459 

2.8889 

2.4612 

2.3928 

o„  (GPa) 

(Max  Tension) 

0.0060 

-0.0003 

0.0114 

-0.0003 

(GPa) 

(Max  Compression) 

-0.0035 

-0.1802 

-0.0035 

-0.1722 

gpiastic  (effective) 

0.1277 

0.1242 

0.1382 

0.1327 

O  (Porosity) 

NA 

NA 

0.1197 

0.1092 

Deflection  (m) 

(Center  Node) 

-0.9219 

-0.8990 

-0.9770 

-0.9420 

The  qualitative  results  for  this  example  are  the  same  as  for  the  clamped  plate.  Since 
the  applied  force  causes  greater  initial  yielding,  void  growth  and  nucleation  has  a  greater 
effect.  The  drilling  moment,  when  added  to  the  void  effects,  reduces  the  amount  of  effective 
plastic  strain  in  tension  and  displacement. 
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E.  ELASTIC  PINCHED  CYLINDER 

An  open-ended  cylinder  of  radius  5.0  in.,  length  10.35  in.,  and  thickness  0.094  in.  is 
subjected  to  a  pinching  load  of  100  lbf  (See  Fig.  6).  The  elastic  modulus  is  10.5  msi, 
Poisson’s  ratio  is  0.3125,  and  the  density  is  3.125xl0"3  slugs/in2.  The  load  is  applied  as  a 
step  function  beginning  at  time  t  =  0  seconds.  Using  symmetry,  the  problem  was  reduced 
to  a  one-eighth  section  of  the  cylinder.  The  dynamic  value  should  be  twice  the  analytic  static 
value.  Inextensional  shell  theory  gives  a  static  radial  contraction  of  0.1117  in.  The 
maximum  radial  contraction  of  the  model  is  0.1995  in.,  which  translates  to  a  static  radial 
contraction  of  0.09975  in.  Using  a  256-element  mesh  (16  by  16),  the  maximum  radial 
contraction  was  0.2207  in.,  for  a  static  contraction  of  0.1 104  in.  The  results  are  summarized 
in  Table  7.  The  16-element  solution  is  within  10.7%  of  the  analytic  solution,  while  the  256- 
element  mesh  is  within  1.21%. 


Table  7.  Comparison  of  Results  for  Elastic  Pinched  Cylinder. 


Analysis  Type 

Radial  Contraction  (in) 

Finite  Element  with  16  Element  Mesh 

0.1995 

Finite  Element  with  256  Element  Mesh 

0.2207 

Analytic  (Twice  the  Static  Solution) 

0.2234 

F.  THICK  PINCHED  CYLINDER  IN  THE  ELASTO-PLASTIC  REGION 

The  material  and  void  properties  shown  in  Tables  2  and  3  are  used  for  an  open-ended 
cylinder  with  a  pinching  force  at  its  center.  The  top  half  of  the  cylinder  is  modeled  using  a 
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36  element  mesh  with  appropriate  symmetry  boundary  conditions  along  the  bottom  edge  of 
mesh,  as  shown  in  Fig.  13.  The  analysis  is  calculated  in  10'5  second  steps,  with  output  every 
2x1 04  seconds,  from  0.0  seconds  to  0.04  seconds.  The  pinching  force  is  66.792  kN  on  each 
side,  with  a  drilling  moment  of  848.258  Nm  applied  on  the  cases  indicated.  The  same  four 
cases  are  compared:  no  voids  or  drilling  moment,  void  effects  only,  drilling  moment  only, 
and  both  void  effects  and  drilling  moment  (DM).  The  effects  of  void  growth  and  nucleation 
and  the  drilling  moment  is  shown  in  the  stress  component  time  histories;  Fig.  14  shows  the 
stresses  without  voids  or  a  drilling  moment,  and  Fig.  15  shows  the  stresses  with  both  effects 
included.  The  results  for  all  cases  are  summarized  in  Table  8. 


Table  8.  Summary  of  Results  for  Elasto-Plastic  Pinched  Cylinder. 


Peak  Values  for  Center 
Element 

No  Voids 

No  DM 

No  Voids 
Drilling  Moment 

Voids 

No  DM 

Voids  and 
Drilling  Moment 

CTvm  (MPa) 

262.40 

265.05 

259.28 

283.49 

Elective  (x  103) 

1.6504 

1.5722 

1.4273 

2.7049 

Qxx  (MPa) 

182.46 

160.38 

170.12 

150.31 

aw  (MPa) 

291.71 

283.77 

291.83 

297.97 

(MPa) 

(Max  Tension) 

5.0619 

-0.0238 

1.0270 

7.5235 

aa  (MPa) 

(Max  Compression) 

-7.6358 

-28.739 

-7.0364 

-35.373 

eplastic  (effective)  (x  103) 

0.7828 

0.7583 

0.5771 

1.6923 

<t>  (Porosity)  (x  103) 

NA 

NA 

0.4773 

1.1970 

Deflection  (mm) 

(Center  Node) 

Global  Maximum 

2.7589 

12.919 

-0.0220 

-0.0214 

Deflection  (mm) 

(Center  Node) 

Global  Minimum 

-31.750 

-31.750 

-31.750 

-31.750 

Since  there  is  only  a  small  amount  of  plastic  strain,  the  effects  of  void  growth  and 
nucleation  are  greatly  reduced.  Even  with  this  small  amount  of  plastic  flow,  the  effective 
plastic  strain  was  increased  by  over  116  percent  with  the  inclusion  of  both  drilling  moment 
and  void  effects,  while  the  peak  center  node  displacement  was  only  increased  by 
approximately  4.5  percent. 


Figure  12.  Mesh  Structure  for  Pinched  Cylinder. 
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Figure  13.  Stress  Component  Time  History  in  Bottom  Fiber:  Pinched  Cylinder, 
No  Void  Effects  or  Drilling  Moment. 
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Figure  14.  Stress  Component  Time  History  in  Bottom  Fiber:  Pinched  Cylinder,  Void  Effects 
and  Drilling  Moment  Applied. 

G.  ELASTIC  SPHERICAL  CAP  WITH  A  CENTER  HOLE 


The  results  of  analysis  with  the  shell  element  developed  here  are  compared  to  results 
of  the  problem  proposed  in  MacNeal  and  Harder  [26].  The  structure  is  a  hemisphere  of 
radius  10  units  with  a  thickness  of  0.04  units,  and  has  an  1 8°  hole  cut  in  the  center.  Taking 
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advantage  of  the  symmetry  in  the  structure,  only  Va  of  the  structure  is  modeled.  An  eight-by- 
eight  mesh  is  used,  for  a  total  of  64  elements,  with  four  integration  points  through  the 
thickness  of  each  element.  The  mesh  used  is  shown  in  Fig.  15.  The  material  properties  of 
the  structure  are:  E  =  6.825xl07,  p  =  0.001,  and  v  =  0.3.  No  void  or  drilling  moment  effects 
are  employed  in  this  example.  Opposing  forces  of  magnitude  2.0  are  applied  at  each 
quadrant:  the  force  at  node  73  is  of  magnitude  -1 .0  and  parallel  to  the  y-axis,  and  the  force 
at  node  one  is  of  magnitude  1 .0  and  parallel  to  the  x-axis.  To  obtain  a  representative  static 
response  using  a  dynamic  model,  the  applied  force  begins  with  0.0  magnitude  at  time  0,  and 
increases  linearly  with  a  rise  time  of  0.16  seconds  to  the  specified  value.  A  calculation  time 
step  of  lxl  O'6  seconds  is  used,  with  termination  at  0.22  seconds.  The  maximum  deflection 
of  node  one  was  0.0929,  where  the  theoretical  value  is  0.0940,  for  a  normalized  displacement 
of  0.988.  This  is  within  the  range  of  the  results  listed  in  MacNeal  and  Harder  from  the 
QUAD2  and  QUAD4  elements,  which  are  considered  to  be  accurate  for  this  problem  [26]. 
These  results  are  summarized  in  Table  9. 


Table  9.  Comparison  of  Results  for  Spherical  Cap  with  Elastic  Loading,  and  Results  from 
MacNeal  and  Harder  [26]. 


New  Shell  Element 

QUAD2 

QUAD4 

Normalized  Displacement 

0.988 

0.986 

1.005 
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Figure  15.  Mesh  Structure  for  Spherical  Cap. 

H.  SPHERICAL  CAP  WITH  A  CENTER  HOLE,  IMPACT  LOADING 

Key  and  Hoff  [11]  used  the  previous  problem  to  test  their  element  with  an  impact 
(step)  load.  The  structure  and  matrial  properties  are  the  same,  and  the  mesh  is  the  same  as 
shown  in  Fig.  15.  The  load  is  applied  at  its  maximum  at  t=0.0+  seconds,  rather  than  ramped 
up.  Figure  16,  which  plots  the  displacement  of  node  one  obtained  from  both  the  shell 
element  presented  here  and  the  element  developed  by  Key  and  Hoff  [11],  shows  that  the 
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results  of  this  element  are  comparable  to  those  obtained  by  other  elements  under  impact 
loading. 


Figure  16.  Node  One  Displacement  Time  History:  Pinched  Spherical  Cap  with  Impact 
Loading. 

I.  SPHERICAL  CAP  WITH  A  CENTER  HOLE,  ELASTO-PLASTIC 
LOADING 

The  spherical  cap  structure  shown  in  Fig.  15  is  now  used  to  verify  the  stability  and 
convergence  of  the  damage-constitutive  equations  under  double  curvature,  and  to  illustrate 
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both  the  effects  of  void  growth  and  nucleation  and  a  drilling  moment  on  a  more  complex 
structure.  The  material  properties  used  are  the  same  as  shown  in  Tables  2  and  3.  The 
structure  has  a  radius  of  5.0  meters  and  a  thickness  of  25  cm,  for  a  radius  to  thickness  ratio 
of  20:1,  commonly  considered  the  limit  of  thin-shell  theory.  Although  a  force  is  applied  at 
each  quadrant,  all  four  loads  are  directed  inwards.  Therefore,  only  one  load  is  applied  at 
node  37  of  the  mesh  shown  in  Fig.  15.  The  applied  load  is  5.9397xl06  N,  with  a  drilling 
moment  of  -7.4246x1 05  Nm  applied  for  the  cases  indicated.  A  calculation  time  step  of 
lxlO'5  seconds  is  used,  with  output  every  5x1  O'4  seconds  and  stopping  at  0.2  seconds.  The 
load  is  initial  zero,  and  increases  linearly  to  its  maximum  at  0.01  seconds.  The  results  shown 
in  Table  10  are  for  the  element  nearest  the  applied  load,  where  stress  is  maximum.  The 
porosity  versus  effective  plastic  strain  relationship  is  shown  in  Fig.  17.  Due  to  the  small 
amount  of  plastic  strain,  porosity  is  restricted  to  the  linear  zone,  as  shown.  Figures  1 8a  and 
18b  illustrate  the  effective  stress  versus  effective  strain  in  the  same  element  on  the 
compressive  side  and  tensile  side,  respectively.  Note  that  as  the  structure  returns  from  a  peak 
displacement,  the  stress  follows  the  elastic  modulus,  not  the  tangent  modulus.  This  reflects 
the  correct  behavior  of  material:  the  elastic  modulus  is  not  affected  by  plastic  deformation, 
only  the  yield  stress  is  affected.  The  node  displacement  where  the  force  is  applied  is  shown 
in  Fig.  19.  This  figure  shows  that  there  are  at  least  two  vibration  modes  in  operation. 
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Table  10.  Summary  of  Results  for  Elasto-Plastic  Spherical  Cap. 


I 


Peak  Values  for 
Element  #25 

No  Voids 

No  DM 

Voids 

No  DM 

Voids  and 
Drilling  Moment 

CTvm  (MPa) 

250.26 

250.76 

_ 

250.26 

250.75 

1.0730 

1.1021 

1.0731 

1.1021 

(MPa) 

202.09 

199.44 

202.08 

199.43 

aw  (MPa) 

-47.093 

-58.183 

-47.087 

-58.192 

Gzz  (MPa) 

-5.2570 

-12.433 

-5.2571 

-12.433 

^plastic  (x  105) 

2.1002 

4.1795 

2.1020 

4.1849 

3>  (Porosity)  (x  106) 

NA 

NA 

6.7149 

12.763 

Deflection  (m) 

(Point  of  Loading) 

0.0233 

0.0246 

0.0233 

0.0246 

Figure  17.  Porosity  versus  Effective  Plastic  Strain  in  Inner  Fiber:  Spherical  Cap  with 
Void  and  Drilling  Moment  Effects. 
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Effective  Stress  Effective  Stress 


Top  Fiber  (Compression) 


Figure  18.  Comparison  of  Void  and  Drilling  Moment  Effects  in  a) 
Compression  (Top)  and  b)  Tension  (Bottom)  for  Spherical  Cap. 
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Node  #37 


Figure  19.  Contact  Node  Mean  Displacement  Time  History:  Spherical  Cap  with  Void  and  Drilling 
Moment  Effects. 


During  testing,  it  became  apparent  that  this  problem  is  not  suitable  for  testing  elasto- 
plastic  analysis.  Since  the  structure  is  concave,  the  entire  structure  quickly  collapses  once 
yielding  begins.  In  addition,  the  single  point  used  to  prevent  rigid-body  motion  also 
provided  a  stress  concentration  and  additional  yielding  (the  "comer"  began  folding  over). 
This  necessitated  using  a  force  that  just  causes  plastic  flow,  but  does  not  collapse  the 
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structure  or  cause  yielding  near  the  anchored  node.  This  is  illustrated  by  an  analysis  of  a  5 
percent  greater  load  than  used  for  the  above  analysis.  The  resulting  node  37  displacement 
is  shown  in  Fig.  20,  and  the  deformed  structure  in  Fig.  2 1 .  However,  it  is  still  apparent  that 
the  qualitative  results  obtained  in  the  previous  elasto-plastic  examples  carried  through  to  this 
problem;  both  voids  and  the  drilling  moment  decreased  stress  in  fibers  under  tension,  and 
increased  stress  in  fibers  under  compression.  Due  to  the  small  amount  of  plastic  strain,  the 
increase  in  porosity  was  extremely  small,  which  minimized  the  effects  of  the  voids. 


Node  #37 


Figure  20.  Contact  Node  Displacement:  Spherical  Cap  with  5%  Greater  Load. 
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5 

y  axis 


Figure  21 .  Deformed  Structure  at  End  of  Analysis:  Spherical  Cap  with  5%  Greater  Load. 
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V.  DYSMAS  IMPLEMENTATION 


After  verifying  the  formulation  using  in-house  code  (see  previous  section  and 
McDermott  and  Kwon  [27]),  the  next  step  was  to  implement  the  formulation  into  DYSMAS, 
using  source  code  provided  by  NSWC  Carderock.  This  section  will  discuss  the  details  of 
implementing  this  shell  formulation  into  the  DYSMAS  source  code. 

Since  DYSMAS  treats  the  constitutive  model,  or  material  model,  separate  from  the 
element  formulation,  it  was  necessary  to  conduct  the  implementation  in  two  steps:  1) 
implement  the  new  shell  formulation  and  verify,  2)  implement  Gurson's  void  model  as  a  new 
material  type  and  verify.  Since  the  source  code  provided  was  not  fully  functional,  several 
corrections  were  required  before  completing  the  shell  formulation  implementation.  These 
corrections  are  summarized  in  Appendix  A. 

A.  GENERAL  IMPLEMENTATION  ISSUES 

The  in-house  code  used  to  test  the  formulation  was  linear,  and  the  integration  scheme 
was  to  step  through  all  the  elements  of  the  same  type,  with  an  inner  loop  for  the  integration 
points.  DYSMAS  is  non-linear  (based  on  strain  increments),  and  divides  each  element  type 
into  groups  of  32,  or  some  other  constant  that  is  determined  before  compiling  (variable 
NLQ).  In  addition,  DYSMAS  steps  through  each  integration  point,  with  an  inner  loop  for 
each  element  in  the  group.  This  required  substantive  modification  to  the  in-house 
implementation.  The  goal  of  this  implementation  is  to  fully  support  all  functions  of 
DYSMAS.  The  areas  where  this  implementation  falls  short  will  be  detailed  later. 
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B.  SHELL  FORMULATION 


The  formulation  is  implemented  by  providing  for  the  following  functions:  data  input 
and  echo,  initialization,  computation,  and  data  output.  All  new  subroutines  are  listed  in 
Appendix  B.  Changes  made  to  original  subroutines  are  highlighted  in  Appendix  C.  The 
following  subroutines  required  modification  in  order  to  support  the  formulation: 

DYNAI  -  read  new  formulation  number  (8),  and  write  to  echo  file 
ELEM2D  -  calls  the  new  formulation  during  the  solution  phase 
The  following  new  subroutines  have  been  implemented: 

KWNMCD  -  main  algorithm  for  new  shell  formulation 

KMTRAN  -  computes  variables  for  traditional  hourglass  control  and  element  area 
KMCON  -  call  appropriate  material  model,  including  Gurson's  Void  Model 
KMFRC  -  computes  hourglass  force  and  puts  internal  forces  into  system  matrix 
KMDRILL  -  computes  drilling  moment  for  applied  forces,  including  contact 
KMCPDP  -  copies  displacements  to/from  global  variables  to/ffom  local  variables 
KMSHAP  -  1-D  shape  function 
KMINV3  -  explicit  3  by  3  matrix  inversion 

All  subroutines  have  been  commented  to  explain  the  details  of  the  algorithm,  so  they 
will  not  be  repeated  here. 
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C.  MATERIAL  MODEL 


The  implementation  of  Gurson's  void  model  required  modification  to  the  following 
subroutines: 

BLKDAT  -  number  of  material  constants  for  new  model 
IN3DIS  -  initialization 

MATIN  -  read  new  material  model  from  input  data  file 

NBSINT  -  initialization 

PENSTF  -  initialization 

STIFFS  -  initialization 

STIFFSN  -  initialization 

PRINTM  -  echo  of  input  material  properties 

SCA_ASC  -  output  of  data  in  ASCII  format 

SCA_DYS  -  output  of  data  in  DYSMAS  format 

SCA_TEC  -  output  of  data  in  TECPLOT  format 

The  following  new  subroutines  were  added  for  the  new  material  model: 

SETS44  -  initialize  material  variables  and  AUX14  variables 
SCA_GET  -  provide  additional  contour  plot  information 
SHL44S  -  new  material  model 

Note  that  SCA_GET  will  also  support  providing  contour  plot  information  for  any 
variable  in  AUX14  of  other  formulations,  but  this  has  not  been  implemented.  Draft  pages 
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for  addition  to  the  user's  guide  covering  the  new  material  model  are  provided  in  Appendix 
D.  Gurson's  void  model  is  implemented  as  material  type  number  44.  The  current 
implementation  does  not  allow  this  material  type  to  be  used  with  any  other  element  type. 

D.  IMPLEMENTATION  ISSUES 

The  following  issues  have  not  been  resolved  for  the  new  implementation: 

1 .  The  indexing  for  updating  shell  thickness  is  incorrect,  and  causes  a  memory  violation. 
The  option  of  updating  the  shell  thickness  for  the  new  formulation  should  not  be  used  until 
this  is  corrected. 

2.  The  calculation  of  the  drilling  moment  utilizes  some  FORTRAN  90  commands,  and 
needs  to  be  revised.  A  better  implementation  would  place  these  calculations  in  FEM3D, 
prior  to  calling  the  appropriate  formulation. 

3 .  There  is  no  theoretical  basis  for  the  critical  time  step  calculation  of  this  element,  even 
though  the  method  used  has  survived  extensive  testing.  This  involves  modifying  the 
computed  surface  area  with  a  normalized  thickness  and  a  constant  (see  KMTRAN  in 
Appendix  B).  It  is  certain  that  since  this  element  provides  full  integration  through  the 
thickness,  the  thickness  affects  the  critical  time  step,  but  not  in  a  linear  manner.  Basing  the 
time  step  on  the  thickness  alone  is  far  too  conservative,  while  neglecting  the  thickness 
frequently  causes  an  unstable  solution.  The  method  shown  in  KMTRAN's  listing  was  used 
with  success  for  all  verfication  problems. 

4.  The  method  of  hourglass  control  is  time-consuming  and  inefficient.  However,  this 
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method  works  when  the  other  methods  available  in  DYSMAS  do  not.  This  method  also 
works  for  other  formulations,  but  is  currently  available  only  in  the  new  formulation.  The 
current  implementation  in  KMFRC  disregards  the  choice  of  hourglass  control  specified  in 
the  input  file,  strictly  using  the  new  method.  This  needs  to  be  revised,  and' using  a  more 
efficient  formulation  for  hourglass  control  would  greatly  improve  efficiency. 

5.  Failure  is  not  implemented  in  either  the  shell  formulation,  or  in  the  material  model. 
This  is  critical,  and  should  be  the  next  step  in  implementation. 

6.  The  subroutines  listed  in  the  appendices  are  "first  drafts."  Although  functional,  no 
emphasis  was  placed  on  efficiency  and/or  speed.  There  is  certainly  room  for  improvement 
in  this  area. 

7.  Dynamic  Relaxation  does  not  work  with  the  new  material  model.  This  is  probably 
caused  by  faulty  energy  calculation  in  SHL44S,  and  must  be  corrected. 

The  current  implementation  is  functional,  and  several  verification  problems  were 
analyzed. 
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VI.  DYSMAS  VERIFICATION 


The  following  problems  were  analyzed  using  the  DYSMAS  implementation 
described  in  the  previous  section.  Since  the  DYSMAS  preprocessor  and  postprocessor  are 
not  available,  both  a  preprocessor  and  postprocessor  that  use  the  ASCII  format  were  created 
using  MATLAB.  All  associated  script  files  are  available  upon  request.  In  addition, 
TECPLOT  was  used  to  show  contour  plots  and  animate  structural  response. 

A.  ELASTIC  CANTILEVER  PLATE  WITH  SMALL  DISPLACEMENT 

A  cantilever  plate  with  small  displacement  that  ensured  all  stresses  were  below 
the  yield  stress  was  tested  using  both  the  in-house  code  (FEA)  and  DYSMAS  with  the 
Belytschko-Tsay,  Hughes-Liu,  QPHM,  and  the  formulation  presented  herein  (referred  to 
as  the  Kwon-McDermott  element).  The  Kwon-McDermott  element  used  the  new 
material  model;  Gurson's  Void  model.  An  analytic  solution  is  available  for  this  problem, 
and  the  results  are  shown  in  Table  1 1 .  Although  the  Kwon-McDermott  element  obtains 
an  answer  closest  to  the  analytic  solution,  this  will  not  always  be  the  case.  The  purpose 
of  this  example  is  only  to  show  that  the  algorithm  has  been  correctly  implemented  for  the 
purely  elastic  case. 


Table  1 1 .  DYSMAS  Solution  of  Cantilever  Plate. 


Solution  Method 

Displacement  (xlO-6  m) 

Error  from  Analytic  (%) 

Analytic 

58.6 

NA 

FEA  (in-house) 

55.368 

11.54 

Belytschko-Tsay 

56.788 

3.09 

Hughes-Liu 

56.788 

3.09 

QPHM 

57.271 

2.27 

Kwon-McDermott 

57.661 

1.60 

This  problem  was  also  used  to  verify  that  the  element  works  correctly  across  more 
than  one  group.  A  simple  four  element  mesh  was  used  to  obtain  the  results  shown  in 
Table  11.  The  same  problem  was  solved  using  a  100  element  mesh,  and  the  Kwon- 
McDermott  element  obtained  the  same  answer;  57.661  x  10'6  m.  This  is  reasonable  since 
the  deflection  is  so  small.  This  problem  was  also  used  to  verify  the  solution  using  the  top 
and  bottom  surfaces,  vice  the  mid-plane,  as  the  reference  surface.  The  element  obtained 
the  same  answer  for  both  the  top  and  bottom  reference  surfaces:  57.662  x  10"6  m.  As 
mentioned  in  the  previous  section,  the  tests  on  dynamic  relaxation  and  updating  the 
element  thickness  both  failed.  Tests  on  the  basis  for  the  sound  speed  passed  for  all  three 
options  available. 

The  tests  using  this  example  were  designed  to  identify  improper  coding,  and  the 
results  show  that  the  element  is  functional,  but  the  calculations  relating  to  dynamic 
relaxation  and  thickness  update  contain  some  errors.  The  same  geometry  was  used  for  a 
different  set  of  dimensions  and  applied  force  using  the  Belytschko-Tsay  and  the  Kwon- 
McDermott  Element.  The  results  are  shown  in  Figure  22. 
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Figure  22.  Comparison  of  Element  Formulations  for  Cantelever  Plate. 

B.  SINGLE  CURVATURE  VERIFICATION:  ELASTIC-PLASTIC  CYLINDER 

The  same  elastic  pinched  cylinder  used  to  verify  the  in-house  code  was  used  with 
the  Kwon-McDermott  element  in  DYSMAS  (See  Table  7).  Figure  23  shows  the  first  run, 
using  a  1/4  cylinder  model  with  appropriate  symmetry  boundary  conditions.  This  figure 
also  verifies  the  changes  made  to  the  TECPLOT  output  subroutines,  along  with  other 
contour  plots  and  animations  (animations  available  upon  request). 
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Figure  23.  Mesh  Structure  for  Pinched  Cylinder  using  TECPLOT. 


Table  12  compares  the  results  from  the  mesh  shown  in  Fig.  23  with  the  results 
shown  in  Table  7.  The  improvement  is  due  to  the  non-linear  solution  method  used  by 
DYSMAS,  vice  the  linear  solution  method  used  in  the  in-house  code. 
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Table  12.  DYSMAS  Elastic  Pinched  Cylinder  Results. 


Solution  Method 

Radial  Contraction  (m) 

Error  from  Analytic  (%) 

Analytic  (Twice  Static) 

0.2234 

NA 

FEA  (16  Element  Mesh) 

0.1995 

10.7 

Kwon-McDermott  (16 
Element  Mesh,  DYSMAS) 

0.2135 

4.4 

Figure  24  shows  an  elastic-plastic  pinched  cylinder  at  the  end  of  a  solution  run.  A 


one-half  structural  mesh  is  used  to  magnify  any  problems  in  the  hourglass  mode  control 


method.  All  other  hourglass  control  methods  available  in  DYSMAS  failed  this  test,  but 


as  Fig.  24  shows,  the  new  method  is  effective.  Since  there  is  no  comparison  data  for  this 


problem,  the  displacement  and  stress  field  will  not  be  discussed. 


Figure  24.  Elastic-Plastic  Pinched  Cylinder  using  DYSMAS. 
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C.  BALL  IMPACT  PROBLEM 


A  test  problem  received  form  NSWC  Carderock  involved  a  solid  ball  striking  a  folly 
clamped  plate.  The  original  plate  was  too  thick  for  adequate  modeling  using  shell  elements, 
as  shown  in  Fig.  25.  The  characteristic  length  to  thickness  ratio  for  this  problem  was  5:1. 


Center  Node  Vertical  Deflection 


Figure  25.  Ball  Impact  Problem  Center  Node  Displacement  with  5:1  Aspect  Ratio. 

The  problem  structure  modeled  with  all  solid  elements  at  the  end  of  the  solution  is 
shown  in  Fig.  26.  The  same  problem  with  the  plate  modeled  using  the  new  shell  element  is 
shown  in  Fig.  27.  The  center  node  displacement  time  history  is  shown  in  Fig.  28,  which  also 
include  the  solution  for  the  Belytschko-Tsay  element.  The  results  for  this  problem  should 
be  the  same  for  both  shell  formulations.  The  additional  rotational  degrees  of  freedom  in  shell 
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elements  allows  an  additional  mode  of  vibration  in  the  plate,  which  explains  the  difference 
between  the  displacement  using  solid  elements  and  the  displacement  using  the  two  shell 
formulations. 


Figure  26.  Ball  Impact  Problem  with  Plate  Modeled  using  Solid  Elements. 
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Figure  27.  Ball  Impact  Problem  with  Shell  Elements. 


Figure  28.  Center  Node  Displacement  Comparison  for  Ball  Impact  Problem. 


For  the  purely  elastic  case,  both  the  element  formulation  and  the  material  model 


provide  correct  answers  for  all  test  problems.  Testing  in  the  elastic-plastic  region  is 


incomplete. 
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VII.  CONCLUSIONS  AND  RECOMMENDATIONS 


A  new  shell  formulation  was  developed  for  transient  dynamic  analysis  which 
includes  both  void  effects  with  plastic  deformation  and  the  transverse  normal  stress  with 
drilling  moment.  The  element  is  compatible  with  most  shell  elements  which  have  three 
translation  and  three  rotation  degrees  of  freedom  per  node. 

A  numerically  stable  scheme  was  developed  for  Gurson's  nonlinear  constitutive 
equation  model.  The  model  includes  both  void  nucleation  and  void  growth.  Furthermore, 
hourglass  control  was  implemented  into  the  algorithm  to  avoid  spurious  modes  caused  by 
the  under-integration  scheme. 

The  drilling  moment  was  important  for  thick  plates  and  shells.  It  induced  large 
transverse  normal  stress  and  affected  the  plastic  deformation.  Similarly,  the  effect  of  voids 
on  plastic  deformation  was  not  negligible.  Numerical  studies  show  that  the  effective  plastic 
strain  increased  up  to  fifteen  percent  due  to  the  combined  effects  of  voids  and  the  transverse 
normal  stress. 

The  element  presented  here  passed  all  testing  when  implemented  into  an  in-house 
finite  element  analysis  code.  The  element  also  passed  ail  testing  in  the  elastic  region  when 
implemented  into  DYSMAS.  Testing  in  the  elastic-plastic  region  was  not  complete  at  the 
time  of  this  report.  The  majority  of  code  modification  and  new  coding  required  to  implement 
the  new  element  into  DYSMAS  is  complete,  although  there  are  a  few  issues  that  must  be 
resolved.  The  current  DYSMAS  implementation  of  this  element  does  not  support  updating 
element  thicknes,  dynamic  relaxation,  or  element  failure.  In  addition,  there  are  several  areas 
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where  improvements  in  efficiency  can  be  made:  drilling  moment  calculation,  critical  time 
step  calculation,  hourglass  control,  and  main  algorithm  calculation.  Material  data  indicating 
the  proper  values  for  the  constants  in  Gurson's  void  model  are  required,  as  are  structural  test 
results  in  the  elastic-plastic  region. 
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APPENDIX  A.  CORRECTIONS  IMPLEMENTED  INTO  DYSMAS. 


FEM3D 

PRTDAT 

SCA_TEC 

TEC_TEN 

TECPLOT 


Corrected  print  interval  calculation  which  caused  all  output  files  to  be 
written  at  each  calculation  time  step. 

Corrected  multiple  file  writes  at  each  print  step. 

Corrected  incorrect  use  of  a  scratch  file. 

Corrected  incorrect  us  of  a  scratch  file. 

Assigned  text  to  current  zone  to  prevent  all  text  being  written  to  base 
frame. 


These  corrections  are  included  in  Appendix  C,  and  comments  in  the  source  code 
detail  the  changes  made. 
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APPENDIX  B.  NEW  DYSMAS  SUBROUTINE  LISTINGS 


(The  following  three  subroutines  are  in  the  file  "kmaux.for") 
c  Following  Subroutines  used  for  Kwon-McDermott  Shell  Element 
c  kminv3  -  computes  inverse  of  a  3  by  3  matrix  (explicitly) 

c  kmshap  -  returns  1-D  shape  function  values  at  zeta 

c  kmcpdp  -  copies  displacements  to/from  global  variables 
c  McDermott  1999  ■ 

subroutine  kminv3(a,  ainv,det) 
c  Direct  calculation  of  3x3  matrix  inverse 
implicit  double  precision  (a-h,o-z) 
dimension  a (3, 3) , ainv (3, 3) 


ainv(l, 1) 
ainv (2, 1) 
ainv (3, 1) 
ainv (1, 2) 
ainv (2, 2) 
ainv (3, 2) 
ainv (1, 3) 
ainv (2, 3) 
ainv (3, 3) 


a  (2, 2)  *a  (3,  3)  -  a  (3,  2)  *a  (2,  3) 
-a  (2, 1)  *a  (3,  3)  +  a  (3, 1)  *a  (2, 3) 
a (2, 1) *a (3, 2)  -  a  (3, 1)  *a  (2, 2) 
-a  (1,  2)  *a  (3,  3)  +  a  (3,  2)  *a  (1, 3) 
a  (1, 1)  *a  (3,  3)  -  a  (3, 1)  *a  (1,  3) 
-a  (1, 1)  *a  (3, 2)  +  a  (3, 1)  *a  (1, 2) 
a  (1, 2)  *a  (2, 3)  -  a  (2, 2)  *a  (1, 3) 
-a  (1, 1)  *a  (2, 3)  +  a  (2, 1)  *a  (1, 3) 
a (1, 1) *a (2, 2)  -  a (2, 1) *a(l,2) 


det  =  a(l, 1) *ainv(l, 1)  +  a (1, 2) *ainv (2, 1) 
1  +  a (1, 3) *ainv(3, 1) 


do  20  j  -  1,3 
do  10  i  =  1,3 

10  ainv(i,j)  =  ainv (i, j ) /det 
20  continue 
return 
end 


subroutine  kmshap (r, shapef) 
c  returns  ID  shape  function 

implicit  double  precision  (a-h,o-z) 
dimension  shapef (2) 

shapef(l)  =  0.5  *  (1  -  r) 
shapef (2)  =  0.5  *  (1  +  r) 
return 
end 

subroutine  kmcpdp (disp, idir, ie) 
c  Copy  displacements  to  a  local  vector 
c  idir  =  1,  copy  to  edispg,  idir=0,  copy  from  edispg 
implicit  double  precision  (a-h,o-z) 
include  'nlqpar.inc' 
common/bk02/iburn, isdo, dtl, dt2 
common/auxlO/area (nlq) , 

1  pxl (nlq) ,px2 (nlq) ,px3 (nlq) ,px4 (nlq) , 

&  px5 (nlq) ,px6 (nlq) ,px7 (nlq) ,px8 (nlq) , 

2  pyl (nlq) , py2 (nlq) , py3 (nlq) , py4 (nlq) , 

&  py5 (nlq) , py6 (nlq) , py7 (nlq) , py8 (nlq) , 

3  pzl (nlq) ,pz2 (nlq) ,pz3 (nlq) ,pz4 (nlq)  , 

&  pz5 (nlq) , pz6 (nlq) , pz7 (nlq)  ,  pz8 (nlq)  , 
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4  dxl (nlq) , dx2 (nlq) , dx3 (nlq) , dx4 (nlq) , 

5  dx5 (nlq) , dx6 (nlq) , dx7 (nlq)  ,  dx8 (nlq)  , 

6  dyl (nlq) ,  dy2 (nlq) , dy3 (nlq) , dy4 (nlq) , 

7  dy5 (nlq) , dy6 (nlq) , dy7 (nlq) , dy8 (nlq) , 

8  dzl (nlq) , dz2 (nlq) , dz3 (nlq) , dz4 (nlq) , 

9  dz5 (nlq) , dz6 (nlq) , dz7 (nlq) , dz8 (nlq) 
common/auxl2/ 

1  wxxl (nlq) , wxx2 (nlq) , wxx3 (nlq) , wxx4 (nlq) , 

2  wyyl (nlq) , wyy2 (nlq) ,  wyy3 (nlq)  ,  wyy4 (nlq)  , 

3  wzzl (nlq) , wzz2 (nlq) , wzz3 (nlq) ,  wzz4 (nlq)  , 

4  al3 (nlq) , a23 (nlq) , a33 (nlq) 
dimension  disp(*) 

if  (idir. eq.l)  then 
disp  (1)  .=  dxl (ie) 
disp  (2)  =  dyl (ie) 
disp (3)  =  dzl (ie) 
disp (4)  =  wxxl(ie) 
disp (5)  =  wyyl (ie) 
disp (6)  =  wzzl (ie) 
disp (7)  =  dx2 (ie) 
disp  (8)  =  dy2 (ie) 
disp (9)  =  dz2 (ie) 
disp (10)  =  wxx2(ie) 
disp (11)  =  wyy2(ie) 
disp(12)  =  wzz2(ie) 
disp (13)  =  dx3 (ie) 
disp (14)  =  dy3(ie) 
disp(15)  =  dz3(ie) 
disp (16)  =  wxx3(ie) 
disp (17)  =  wyy3(ie) 
disp(18)  =  wzz3(ie) 
disp(19)  =  dx4(ie) 
disp (20)  =  dy4 (ie) 
disp (21)  =  dz4 (ie) 
disp (22)  =  wxx4 (ie) 
disp (23)  =  wyy4(ie) 
disp(24)  =  wzz4(ie) 

else 

dxl (ie)  =  disp  (1) 
dyl (ie)  =  disp (2) 
dzl (ie)  =  disp  (3) 
wxxl(ie)  =  disp (4) 
wyyl(ie)  =  disp (5) 
wzzl(ie)  =  disp(6) 
dx2 (ie)  =  disp (7 ) 
dy2 (ie)  =  disp (8) 
dz2 (ie)  =  disp (9) 
wxx2 (ie)  =  disp (10) 
wyy2(ie)  =  disp (11) 
wzz2(ie)  =  disp(12) 
dx3(ie)  =  disp(13) 
dy3(ie)  =  disp(14) 
dz3(ie)  =  disp(15) 
wxx3(ie)  =  disp (16) 
wyy3(ie)  =  disp (17) 
wzz3(ie)  =  disp(18) 
dx4 (ie)  =  disp (19) 
dy4(ie)  =  disp (20) 
dz4 (ie)  =  disp (21) 
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wxx4 (ie) 
wyy4 (ie) 
wzz4 (ie) 
endif 
return 
end 


=  disp(22) 
=  disp(23) 
=  disp(24) 


subroutine  kmcon  (nmtcon, auxvec, cm, lav, mte, nip, ipt, capa, 

1  dampk, ym,prv,mxe) 

c  Constitutive  Equation  Driver  for  Kwon-McDermott  Shell  Element 
c  Works  the  same  as  the  drivers  for  the  other  formulations,  but  will 

c  calculate  sig3  for  materials  that  set  it  to  zero.  Only  mat  #44 

c  calculates  and  retains  sig3 

c  McDermott  1999 

q  ★*********^**************^**********^********************'**''*,,*,*,*'’A>‘A-**'^r 

implicit  double  precision  (a-h,o-z) 
dp 

include  'nlqpar.inc' 
common/bkOl/itherm, itemp, ntmpO, ntmpl 

Common/bk07/nl,n2,n3,n4,n5,n6,n7,n8,n9,nl0,nll,nl2,nl3,nl4,nl5, 

1  nl6, nl7, nl8, nl9, n20, n21, n22, n23,  n24 , n25, n26,  n27, n28, n29, n30, n31, 

2  n32,n33,n34,n35,n36,n37,n38,n39,n40,n41,n42,n43,n44,n45, 

3  n4  6, n47, n48, n4  9, n50, n51, n52, n53,  n54 ,  n55,  n56,  n57,  n58,  n59, n60, n61, 

4  n62,n63,n64,n65,n66,n67,n68,n69,n70,n71,n72,n73,n74,n75,n76,n77, 

5  n78,n79, n80, n81, n82, n83, n84, locend, iname, lendf 
common/bkl3/lc0,  lclh,  lclb,  lcls,  lclt,  lc2,  lc3,  lc4',  lc5,  lc6,  lc7,  lc9, 

1  IclO, lcll, lcl2, lcl3, Icl4,lcl5,lcl6,lcl7,lcl8, lbO, lbl, lb2, 

2  Ic7a,lc7b 

common/aux2/dl (nlq) , d2 (nlq) ,  d3 (nlq)  ,  d4 (nlq) ,  d5 (nlq) ,  d6 (nlq) , 

1  wzzdt (nlq) , wyydt (nlq) , wxxdt (nlq)  ,  einc (nlq) 
common/auxl4 / 

1  sigl (nlq) , sig2 (nlq) , sig3 (nlq) , sig4 (nlq) , 

2  sig5 (nlq) , sig6 (nlq) ,  ep (nlq) , epxl (nlq) , 

3  epx2 (nlq) , epx4 (nlq) , epx5 (nlq) , epx6 (nlq) , aux (nlq, 59) 
common/aux36/lft,  lit 

common/ shlopt/istrn, istupd,  ibelyt, miter 
common  /  /  a (1) 

dimension  cm(48, *) , auxvec (*) ,  sg3 (nlq) ,  d3t (nlq) 

c  Get  previous  stress  tensor  for  current  ipt 
lavloc= (ipt-1) *nmtcon+lav 

call  tbscls  (nmtcon, auxvec (lavloc) , nip*nmtcon) 

c  If  not  a  material  type  that  supports  PCM  element,  store  sig3  &  d3 
if (mte.ne. 44)  then 
do  10  i=lft, lit 
d3t (i)  =  d3(i)  • 
sg3 (i)  =  sig3 (i) 

10  continue 
endif 

c  ***  Call  appropriate  Consitutive  Model 
if  (mte.eq.l)  then 
call  shlls  (cm, capa) 
elseif  (mte.eq.2)  then 
call  shl2s  (cm, capa) 

elseif  (mte.eq.3)  then  ■ 

if  (miter. eq.O)  then 
call  sh3sc  (cm, capa) 
elseif  (miter. eq.l)  then 
call  shl3s  (cm, capa) 
elseif  (miter. eq. 2)  then 
call  sh3si  (cm, capa) 
endif 

elseif  (mte.eq.4)  then. 
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call  shl4s  (cm, a (ntmpO+1) ,  a (nl9) ) 
elseif  (mte.eq.12)  then 
call  shll2s  (cm, capa) 
elseif  (mte.eq.15)  then 
call  shll5s  (cm, capa) 
elseif  (mte.eq.18)  then 
call  feml8s  (cm, capa) 
elseif  (mte.eq.19)  then 
if  (miter. eq.O)  then 
call  shl9sc  (cm, a (n8) , a (n9) , capa) 
elseif  (miter. eq.l)  then 
call  shll9s  (cm,a(n8) ,a(n9),capa) 
elseif  (miter. eq. 2)  then 
call  shl9si  (cm, a (n8) , a (n9) , capa) 
endif 

elseif  (mte.eq.21)  then 
call  shl21s (cm, capa, a (ntmpO+1)  ,  a (nl9) ) 
elseif  (mte.eq.22)  then 
call  shl22s (cm, capa) 
elseif  (mte.eq.23)  then 
lthrpr=nint ( cm ( 4  8 , mxe ) ) 

call  shl23s (cm, capa, a (ntmpO+1) , a (nl9) , a (lthrpr) , 
1  a (n8) , a (n9) , a (lcll) ) 

elseif  (mte.eq.24)  then 
if  (miter. eq.O)  then 
call  sh24sc  (cm, a (n8 ) , a (n9) , capa) 
elseif  (miter. eq.l)  then 
call  shl24s  (cm, a (n8 ) , a (n9) , capa) 
elseif  (miter. eq. 2)  then 
call  sh24si  (cm, a (n8 ) , a (n9) , capa) 
endif 

elseif  (mte.eq.28)  then 
call  shl28s  (cm, capa) 
elseif  (mte.eq.30)  then 
call  shl30s  (cm, capa) 
elseif  (mte.eq.33)  then 
call  shl33s  (cm, capa) 
elseif  (mte.eq.34)  .  then 
call  shl34s  (cm, capa) 
elseif  (mte.eq.35)  then 
if  (miter. eq.O)  then 
call  shl35s (cm, a (n8) , a (n9) , capa) 
elseif  (miter. eq.l)  then 
call  shl35s (cm, a (n8 ) , a (n9) , capa) 
elseif  (miter. eq. 2)  then 
call  shl35s (cm, a (n8) , a (n9) , capa) 
endif 

elseif  (mte.eq.38)  then 
call  shl38s (cm, capa) 
elseif  (mte.eq.39)  then 
call  shl39s (cm, capa) 
elseif  (mte.eq.41)  then 
call  shl41s (cm, capa) 
elseif  (mte.eq.42)  then 
call  shl42s (cm, capa) 
elseif  (mte.eq.44)  then 
call  shl44s (cm, capa) 
else 

write (39, 1000) 
write  (13, 1000) 
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■  call  adios(2) 

1000  format ( //5x, ' ***  illegal  material  for  kwon-mcdermott  shell 
1  /5x,  '  execution  aborted  ') 

endif 

c  Calculate  elastic  sig3  for  types  that  do  not  support  KM  element 
if  (mte.ne.44)  then 
do  20  i=lft, lit 
d3  (i)  =  d3t  (i) 
sig3(i)  =  sg3(i)  +  ym*d3(i) 

20  continue 
endif 

c  Store  new  stress  tensor  for  current  ipt 

call  tbsc2s  (nmtcon, auxvec (lavloc) , lav, nip*nmtcon, nip, ipt) 

c  Apply  Rayleigh  Damping 

if  (dampk. ne . 0 . )  call  rydmp2 (dampk, ym,pr) 

return 

end 


*** 
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subroutine  kmdrill (e, f , ndlist, nlstm) 

q  'k-k-k'k'k-k-k-k'k-k'k'k-k’k'k'k'k-k-k’k-k'k'k’ir'jcfr-k'k’ie'k'k'k'k'k’k'k'k'k'k'k'k'k’k'k'ick’k'k-k'k'k’k'k’k'fc'k'k'k 

c  Calculates  Drilling  Moment  associated  with  external  forces 
c  for  Kwon-McDermott  shell  element 

c  (Does  this  by  calculating  a  normal  vector  at  each  node 

c  then  finding  the  dot  product  with  the  applied  forces) 

c  McDermott  1999 

c  Variable  Listing 
c  e  -  nodal  force  array 

c  f  -  nodal  moment  array 

c  ndlist  -  array  of  nodes  affected  by  this  element  group' 

c  nlstm  -  number  of  entries  in  ndlist 

c  ************************************************************ 

implicit  double  precision  (a-h,o-z) 
include  ’ nlqpar.inc' 

common /bkOO/numnp, numpc, numlp, neq, ndof , nlcur, numcl, numvc, 

1  ndtpts, nelmd, nmmat, numelh, numelb, numels, numelt , numdp, 

2  grvity, idirgv, nodspc, nspcor 
common/bk02/iburn, isdo, dtl, dt2 
common/auxl3/ 

&zeta (nlq) , thick (nlq) , fga (nlq) , fgb (nlq) , fgc (nlq) , 

&glll (nlq) ,  gll2 (nlq) ,  gll3 (nlq) , gl21 (nlq) , gl22 (nlq) , gl23 (nlq) , 
&gl31 (nlq) ,  gl32 (nlq) , gl33 (nlq) , 

&xl (nlq) , yl (nlq) , zl (nlq) , x2 (nlq) , y2 (nlq) , z2 (nlq) , 

&x3 (nlq) , y3 (nlq) , z3 (nlq) , x4 (nlq) ,  y4 (nlq) ,  z4 (nlq)  , 

&fxl (nlq) , fyl (nlq) , fzl (nlq) , fx2 (nlq) , fy2 (nlq) ,  f z2 (nlq)  , 

&fx3 (nlq) , fy3 (nlq) , fz3 (nlq) , fx4 (nlq) , fy4 (nlq) ,  fz4 (nlq) , 

&xmxl (nlq) , xmyl (nlq) , xmzl (nlq) , xmx2 (nlq) , xmy2 (nlq) , xmz2 (nlq) , 
&xmx3 (nlq) , xmy3 (nlq) , xmz3 (nlq) , xmx4 (nlq) , xmy4 (nlq) , xmz4 (nlq) 
common/aux33/ 

1  ixl (nlq) ,  ix2 (nlq) ,  ix3 (nlq) , ix4 (nlq) , ixs (nlq, 4 ) ,mxt (nlq) 
common/aux36/lft, lit 

dimension  e (3, *) , f (3, *) , ndlist (*) 
allocatable  anorm (:,:), thnod ( : ) , nth ( : ) 

c  Set  up  &  initialize  nodal  arrays 

allocate (anorm (3, numnp) , thnod (numnp) , nth (numnp) ) 
call  azero (anorm, numnp* 3) 
call  azero (thnod, numnp) 
call  iazero (nth, numnp) 

c  Get  component  normal  to  plane  of  element  and  add  to  nodes 
do  10  i=lft,llt 

anorm (1,  ixl (i) ) =anorm (1, ixl (i) ) +gll3  (i) 
anorm(2, ixl (i) )=anorm(2, ixl (i) ) +gl23 (i) 
anorm  (3,  ixl  (i)  )  =anorm(3,  ixl  (i) )  +gl33  (i) 
anorm  (1,  ix2  (i)  )  =anorm  (1,  ix2  (i)  )  +gll3  (i) 
anorm(2, ix2 (i) ) =anorm(2, ix2 (i) ) +gi23 (i) 
anorm (3, ix2 (i) ) =anorm(3, ix2 (i) ) +gl33 (i) 
anorm (1, ix3 (i) ) =anorm (1, ix3 (i) ) +gll3 (i) 
anorm (2, ix3 (i) ) =anorm (2, ix3 (i) ) +g!23  (i) 
anorm (3, ix3 (i) ) =anorm (3, ix3 (i) ) +gl33 (i) 
anorm (1, ix4 (i) ) =anorm(l, ix4 (i) ) +gll3 (i) 
anorm  (2,  ix4  (i)  )  =anorm (2,  ix4  (i)  )  +gl23  (i) 
anorm  (3,  ix4 (i) ) =anorm (3, ix4 (i) ) +gl33  (i) 
thnod (ixl (i) ) =thnod (ixl (i) ) +thick (i) 
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thnod(ix2 (i) )=thnod(ix2 (i) ) +thick(i) 
thnod (ix3 (i) )=thnod(ix3 (i) )+thick(i) 
thnod ( ix4 ( i ) ) =thnod ( ix4 { i ) ) +thick ( i ) 
nth ( ixl ( i ) ) =nth ( ixl ( i ) ) +1 
nth (ix2 (i) ) =nth (ix2 (i) ) +1 
.  nth (ix3 (i) ) =nth (ix3 (i) ) +1 
nth (ix4 (i) ) =nth (ix4 (i) ) +1 
10  continue 

c  Loop  through  each  node 
do  20  n=l, nlstm 
i=ndlist(n) 
if (nth (i) .ne. 0)  then 

c  Make  each  normal  vector  a  unit  vector 

amag=sqrt (anorm (1, i) **2  +  anorm (2, i) **2  +  anorm(3, i) **2) 
if  (amag. gt . 0 . 0)  then 
anorm (1, i) =anorm {1, i) /amag 
anorm (2, i) =anorm (2, i) /amag 
anorm (3, i) =anorm (3, i) /amag 
endif 

c  Dot  product  of  external  moment  with  unit  normal 

gnorm=f  (1,  i)  *anorm  (1,  i)  +f  (2,  i)  *  anorm  (2,  i)  +f  (3,  i)  *  anorm  (3,  i) 
c  Dot  product  of  external  force  with  unit  normal 

fnorm=e  (1,  i)  *anorm(l,  i)  +e (2, i)  *  anorm  (2,  i)  +e  (3,  i)  *anorm  (3,  i) 
c  If  gnorm  is  nonzero,  this  node  as  been  treated  before 
if (abs (gnorm) . It . 0 . 01)  then 
c  If  not  zero,  add  h/2  *  fnorm  to  drilling  moment 
if (abs (fnorm) . gt . 0 . 0001)  then 
fdrill=fnorm*0 . 5*thnod (i) /nth (i) 
f (1, i) =anorm(l, i) *f drill 
f (2, i) =anorm(2, i) *fdrill 
f (3,  i) =anorm (3, i) *fdrill 
endif 
endif 
endif 

20  continue 

c  Release  Nodal  Arrays 

deallocate (anorm, thnod, nth) 

return' 

end 
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subroutine  kmfrc (e, f, qs,mte, iblks, sfl, sf2, sf3, sf4, sf5, sf 6, 

1  ndlist, nlstm, ym, rotall, x, xO) 

******************************************************************** 

Calculates  Hourglass  force,  adds  to  nodal  forces  from  Kwon-McDermott 
Shell  Element,  and  places  in  system  force  matrix 
(Note:  sfl  through  sf6  are  already  in  global  coordinates) 

McDermott  1999 

implicit  double  precision  (a-h,o-z) 
dp 

include  'nlqpar.inc' 

common/bkOO/numnp, numpc, numlp, neq, ndof , nlcur, numcl, numvc, 

1  ndtpts , nelmd, nmmat , numelh, numelb, numels , numelt , numdp, 

2  grvity, idirgv, nodspc, nspcor 
common/bk02/iburn, isdo, dtl, dt2 
common/bkl2/bl2, b2, qhg 
common/auxOl/ 

&ftll (nlq) , ftl2 (nlq) , ftl3 (nlq) , ft21 (nlq) , ft22 (nlq)  ,  ft23 (nlq) , 
&fmll (nlq) , fml2 (nlq) , fm2l (nlq) , fm22 (nlq) , 

&fm31 (nlq) , fm32 (nlq) , fm41 (nlq) , fm42 (nlq) , 

Sfmrll (nlq) , fmrl2 (nlq) , fmr21 (nlq) , fmr22 (nlq) , fmr31 (nlq) , 

&fmr32 (nlq) , fmr41 (nlq) , fmr42 (nlq) , sg5 (nlq)  ,  sg6 (nlq) 
common/aux7/  .  , 

1  vxl (nlq) , vx2 (nlq) , vx3 (nlq) , vx4 (nlq) , 

2  vx5 (nlq) , vx6 (nlq) , vx7 (nlq) ,  vx8 (nlq) , 

3  vyl (nlq) , vy2 (nlq) , vy3 (nlq) ,  vy4 (nlq) , 

4  vy5 (nlq) ,vy6 (nlq) , vy7 (nlq) ,  vy8 (nlq) , 

5  vzl (nlq) ,vz2 (nlq) , vz3 (nlq) ,vz4 (nlq) , 

6  vz5 (nlq) ,vz6 (nlq) , vz7 (nlq) , vz8 (nlq) 
common/auxlO/area (nlq) , 

1  pxl (nlq) ,px2 (nlq) ,px3 (nlq) ,px4 (nlq) , 

&  px5 (nlq) ,px6 (nlq) ,px7 (nlq) ,px8 (nlq) , 

2  pyl (nlq) ,py2 (nlq) ,py3 (nlq) ,py4 (nlq) , 

&  py5 (nlq) ,py6 (nlq) ,py7 (nlq)  ,py8 (nlq)  , 

3  pzl (nlq) ,pz2 (nlq) ,pz3 (nlq)  ,pz4 (nlq) , 

&  pz5 (nlq) ,pz6 (nlq) ,pz7 (nlq) ,pz8 (nlq) , 

4  dxl (nlq) ,dx2 (nlq) ,dx3 (nlq)  ,dx4 (nlq)  , 

5  dx5 (nlq) , dx6 (nlq) , dx7 (nlq) , dx8 (nlq)  , 

6  dyl (nlq) , dy2 (nlq) , dy3 (nlq) ,  dy4 (nlq)  , 

7  dy5 (nlq) , dy6 (nlq) , dy7 (nlq) ,  dy8 (nlq)  , 

8  dzl (nlq) , dz2 (nlq) , dz3 (nlq) , dz4 (nlq) , 

9  dz5 (nlq) , dz6 (nlq) , dz7 (nlq) , dz8 (nlq) 
common/auxll/ 

&ft31 (nlq) , ft32 (nlq) , ft33 (nlq) , ft41 (nlq) ,  ft42 (nlq) , ft 43 (nlq) , 

&htx (nlq) , hty (nlq) , gml (nlq) , gm2 (nlq) , gm3 (nlq) , gm4 (nlq) , 

&bsum (nlq) , qhx (nlq) , qhy (nlq) , qwz (nlq) , qtx (nlq) , qty (nlq) 
common/auxl3/ 

&zeta (nlq) , thick (nlq) , fga (nlq) , fgb (nlq) ,  fgc (nlq) , 

&glll (nlq) ,  gli2 (nlq) , gll3 (nlq)  ,  gl21 (nlq) ,  gl22 (nlq)  ,  gl23 (nlq) , 
&gl31 (nlq) , gl32 (nlq) ,  gl33 (nlq)  , 

&xl (nlq) , yl (nlq) , zl (nlq) ,x2 (nlq) , y2 (nlq) ,  z2 (nlq)  , 

&x3 (nlq) , y3 (nlq) , z3 (nlq) , x4 (nlq) , y4 (nlq) ,  z4 (nlq) , 

&fxl (nlq) , fyl (nlq) , f zl (nlq) , fx2 (nlq) , fy2 (nlq) , f z2 (nlq) , 

&fx3 (nlq) , fy3 (nlq) , f z3 (nlq) , fx4 (nlq) ,  fy4 (nlq) ,  f z4 (nlq) , 

&xmxl (nlq) , xmyl (nlq) , xmzl (nlq) , xmx2 (nlq) , xmy2 (nlq) , xmz2 (nlq) , 
&xmx3 (nlq) , xmy3 (nlq) , xmz3 (nlq) ,  xmx4 (nlq)  ,  xmy4 (nlq) , xmz4 (nlq) 
common/aux33/ 

1  ixl (nlq) , ix2 (nlq) , ix3 (nlq) , ix4 (nlq) , ixs (nlq, 4) ,mxt (nlq) 
common/aux35/rhoa (nlq) , cxx (nlq) , fcl (nlq) ,  fcq (nlq) 
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common/aux36/lft,  lit 
.  common/aux40/  • 

1  x31 (nlq) , y31 (nlq) ,  z31 (nlq) , x42 (nlq)  ,  y42 (nlq) ,  z42 (nlq) , 

2  x21 (nlq) , y21 (nlq) , z21 (nlq) ,  cl (nlq) ,  c2 (nlq)  ,  c3 (nlq) , xl (nlq) , 

3  x41 (nlq) , y41 (nlq) , z41 (nlq) 

common/hourg/ymod, gmod,  if sv 
•common/sandl/ihf , ibemf, ishlf , itshf 

common/sound/sndspd,  sndsp  (nlq) ,  diagm (nlq)  ,  sarea  (nlq)  ,  dxl  (nlq) 
common/ssbsis/h(8, 5,5)  ,pr  (8, 5,  5)  ,ps  (8, 5,  5)  ,pt  (8,5,5)  ,  ipt,  : 

1  nip,  wgts  (5,  5)  ,  zet  (5, 5) 
common/presc/voltot (nlq) 
common/failul/sieu (nlq) , fail (nlq) 
logical  output 

common/csforc/csdinc, csdout, output,  ncsl, ncs2,  ncs3, ncs4 , ncs5, ncs6, 
1  ncs7,ncs8,ncs9,numcsd 

common/csf sav/savf rc (nlq, 12 ) , svf ail (nlq) ,  ndf , if ail 
common/sorter/nnc,  lczc, 

&  ns  1 1, nsl2, ns 13, ns 14, ns 15, ns 16, ns 17, 

&  nhll,nhl2,nhl3,nhl4,nhl5,nhl6,nhl7, 

&  ntll,ntl2, ntl3, ntl4, ntl5, ntl6, ntl7, 

&  nbll, nbl2, nbl3, nbl4, nbl5, nbl6, nbl7 

dimension  e(3,*)  ,  f  (3,  *) ,  qs  (9,  *') ,  iblks  (* ) , sf 1  (nlq,  4 )  ,  sf  2  (nlq,  4 )  , 

1  sf 3 (nlq, 4 ) , sf 4 (nlq, 4 )  ,  sf 5 (nlq,  4 )  ,  sf 6 (nlq,  4 )  ,  ndlist ( * ) 

2 

edispg (24 ) , eforceh (24) , rotall (6, 6, nlq) , shapel (3) , x (3, *) , 

3 

shapef (4 ) , derivl (2,4), derivg (3, 4 )  ,  derilg (3,4), bmtx (6,24) , 

4 

bmtxt (24,6), estrain (6) ,  estrainp (6) ,  estress (6) , estressg (6) , 

5 

eforcehg (24, nlq) , fml3 (nlq) , fm23 (nlq) , vl (3) , v2 (3) , v3 (3) , 

6 

fm33 (nlq) , fm43 (nlq) , aj (3, 3) , ajinv (3, 3) , hour (nlq)  ,  xO (3, *) , 

7 

edisp (24 ) , tl (3, 3) , tlinv (3, 3) , xc (4 )  ,  yc (4 ) ,  zc (4 ) ,  rot ( 6, 6) 

data  ngausxh, ngausyh, ngauszh  /2,  2,  1/ 
data  sfac  /0 . 833333333333333/ 

ifail=0 

c  Force  use  of  new  HG  method 
hourl  =0.5 
method  =5 

if  (hourl . gt . 1 . e-04 )  then 

c  ***  Specialized  hourglass  control  based  on  Belytchko  Stiffness  form 
c  (Although  slower,  highly  recommended  for  KM  element)  ■ 
if  (method. eq. 5)  then 
c  Parameter  setup 

ngaussh=ngausxh*ngausyh*ngauszh 
if  (gmod. ne . 0 . 0)  then 
pois  =  ymod  /  (2.0  *  gmod)  -  1.0 
else 

pois  =0.3 
gmod  =  ymod  /  2.6 
endif 

front  =  ymod  /  (1.0  -  pois**2) 
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Begin  Element  Loop 

do  900  ie=lft,llt 

hour(ie)  =  hourl  *  thick (ie)**2  /  area(ie) 

Retreive  coordinates 

xc ( 1 ) =x0 ( 1 , ixl ( ie ) ) 
yc ( 1 ) =x0 ( 2 , ixl ( ie ) ) 
zc  (1)  =x0  (3,  ixl  (ie)  ) 
xc (2) =x0 (1, ix2 (ie) ) 
yc ( 2 ) =x0 ( 2 , ix2 ( ie ) ) 
zc  (2)  =x0  (3,  ix2  (ie)  ) 
xc ( 3 ) =x0 ( 1 , ix3 ( ie ) ) 
yc ( 3 ) =x0 ( 2 , ix3 ( ie ) ) 
zc (3) =x0 (3, ix3  (ie) ) 
xc ( 4 ) =x0 ( 1 , ix4 ( ie ) ) 
yc (4 ) =x0 (2, ix4  (ie) ) 
zc (4 ) =x0 (3, ix4 (ie) ) 

Retrieve  displacments 

edispg(l)  =  x (1,  ixl (ie) ) -xc (1) 
edispg(2)  =  x (2, ixl (ie) ) -yc (1) 
edispg(3)  =  x (3, ixl (ie) ) -zc (1) 
edispg(7)  =  x (1, ix2 (ie) ) -xc (2) 
edispg(8)  =  x (2, ix2 (ie) ) -yc (2) 
ed'ispg(9)  =  x  (3,  ix2  (ie)  ) -zc  (2) 
edispg(13)  =  x (1, ix3 (ie) ) -xc (3) 
edispg(14)  =  x (2, ix3 (ie) ) -yc (3) 
edispg(15)  =  x (3, ix3 (ie) ) -zc (3) 
edispg(19)  =  x (1, ix4 (ie) ) -xc (4 ) 
edispg(20)  =  x  (2, ix4 (ie) ) -yc (4 ) 
edispg(21)  =  x (3, ix4 (ie) ) -zc (4 ) 

Retreive  Rotations  (Assumes  all  initial  rotations  are  zero) 
edispg(4)  =  x (1, numnp+ixl (ie) ) 
edispg(5)  =  x (2, numnp+ixl (ie) ) 
edispg(6)  =  x (3, numnp+ixl (ie) ) 
edispg(lO)  =  x (1, numnp+ix2 (ie) ) 
edispg(ll)  =  x (2,numnp+ix2 (ie) ) 
edispg(12)  =  x (3, numnp+ix2 (ie) ) 
edispg(16)  =  x (l,numnp+ix3 (ie) ) 
edispg(17)  =  x (2, numnp+ix3 (ie) ) 
edispg(18)  =  x (3, numnp+ix3 (ie) ) 
edispg(22)  =  x (1, numnp+ix4 (ie) ) 
edispg(23)  =  x (2, numnp+ix4 (ie) ) 
edispg(24)  =  x (3, numnp+ix4 (ie) ) 

Create  Transformation  Matrix  and  get  inverse 
tl (1, l)=glll (ie) 
tl (2,l)=gl21(ie) 
tl (3,1) =gl31 (ie) 
tl (l,2)=gll2 (ie) 
tl (2, 2) =gl22 (ie) 
tl (3, 2) =gl32 (ie) 
tl (1, 3) =gll3 (ie) 
tl (2,3) =gl23 (ie) 
tl (3, 3) =gl33 (ie) 

call  kminv3 (tl, tlinv, det) 

Rotate  displacements  to  local  coordinate  system 
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do  950  i=l, 4 
do  950  j=l, 3 

edisp ( ( i— 1 ) *6+j ) =edispg ( ( i— 1 ) *6+j ) 

edisp ( ( i— 1 ) *6+3+ j ) = (edispg ( ( i — 1 ) *6+4 ) *tlinv ( j , 1 )  + 

1  edispg  (  { i — 1 )  *6+5)  *tlinv  (j  ,  2)  + 

2  edispg ( ( i— 1 ) *6+6) *tlinv (j , 3) ) 

950  continue 

c  Rename  Direction  Vectors  to  allow  simple  porting  of  previously 

c  written  code 

vl(l)  =  gill (ie) 
vl  (2 )  =  gl21 (ie) 
vl  (3)  =  gl31 (ie) 
v2 (1)  =  gll2 (ie) 
v2  (2)  =  gl22  (ie) 
v2  (3)  =  gl32  (ie) 
v3 (1)  =  gll3 (ie) 
v3 (2)  =  gl23 (ie) 
v3 (3)  =  gl33 (ie) 
hzdt=thick (ie) *0 . 5 

c  Initialize  Hourglass  force  vector 
do  901  i=l, 24 
901  eforceh(i)  =0.0 

c  ***  Integration  Loop 

do  910  ix=l,ngausxh 
rc=zet (ix, ngausxh) 
wx=wgts (ix,ngausxh) 
do  910  iy=l, ngausyh 
sc=zet ( iy, ngausyh) 
wy=wgts (iy, ngausyh) 
do  910  iz=l,ngauszh 
tc=zet (iz, ngauszh) 
wz=wgts (iz, ngauszh) 

c  1-D  Shape  Function 

call  kmshap (tc, shapel) 

c  2-D  Shape  Functions 

shapef (1)=0.25* (1.0-rc) * (I. 0-sc) 
shapef (2) =0 . 25* (1 . 0+rc) * ( 1 . 0-sc) 
shapef (3) =0 . 25* (1 . 0+rc) * (1 . 0+sc) 
shapef (4 ) =0 . 25* ( 1 . 0-rc) * (1 . 0+sc) 

c  2-D  Shape  Function  Derivatives 

derivl (1, 1) =-0 . 25* ( 1 . 0-sc) 
derivl (1, 2) =0 . 25* (1 . 0-sc) 
derivl (1,  3) =0 . 25* (1 . 0+sc) 
derivl (1, 4) =-0.25* (1. 0+sc) 
derivl (2, 1) =-0 . 25* ( 1 . 0-rc) 
derivl (2, 2 ) =-0 . 25* ( 1 . 0+rc) 
derivl (2, 3) =0 . 25* ( 1 . 0+rc) 
derivl (2, 4) =0.25*. (1.0-rc) 


c  Compute  jacobian  matrix  and  its  inverse 

hz=thick(ie) *0 . 5* (shapel (2) -shapel (1) ) 

aj (1,1) =derivl (1,1) *xc (1) +derivl (1,2) *xc (2) +derivl (1, 3) *xc(3) + 
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1  derivl (1,4) *xc ( 4 ) +derivl (1,1) *hz*v3 ( 1 ) + 

2  derivl (1,2) *hz*v3 (1) +derivl (1, 3) *hz*v3 (1) + 

•  3  derivl (1,4) *hz*v3 (1) 

aj (2, 1) =derivl (2,1) *xc (1 ) +derivl (2,2) *xc (2 ) +derivl (2,3) *xc (3) + 

1  derivl (2, 4) *xc (4) +derivl (2,1) *hz*v3 (1)  + 

2  derivl (2,2) *hz*v3 (1) +derivl (2,3) *hz*v3 (1) + 

3  derivl (2,4) *hz*v3 (1) 

aj (3, 1) =hzdt*v3 (1) 

aj (1, 2) =derivl (1,1) *yc (1) +derivl (1,2) *yc (2) +derivl (1,3) *yc (3) + 

1  derivl (1, 4) *yc (4) +derivl (1, 1) *hz*v3 (2)  + 

2  derivl ( 1 , 2 ) *hz*v3 (2 ) +derivl ( 1 , 3 ) *hz* v3 (2 ) + 

3  derivl (1, 4) *hz*v3 (2) 

aj  (2,2) =derivl (2,1) *yc ( 1) +derivl (2,2) *yc (2) +derivl (2, 3) *yc (3)  + 

1  derivl (2,4) *yc ( 4 ) +derivl (2,1) *hz*v3 (2) + 

2  derivl (2,2) *hz*v3 (2) +derivl (2,3) *hz*v3 (2) + 

3  derivl (2, 4 ) *hz*v3 (2) 

aj (3,  2) =hzdt*v3 (2) 

aj (1,3) =derivl (1, 1) *zc (1 ) +derivl ( 1, 2) *zc (2) +derivl (1, 3) *zc  (3)  + 

1  derivl (1, 4 ) *zc (4 ) +derivl (1,1) *hz*v3 (3) + 

2  derivl (1, 2) *hz*v3 (3) +derivl (1, 3) *hz*v3 (3) + 

3  derivl (1, 4) *hz*v3 (3) 

aj  (2, 3)  =derivl  (2, 1)  *zc  (1 )  +derivl  (2, 2 )  *zc  (2)  +derivl  (2, 3)  *zc  (3)  + 

1  derivl (2, 4 ) *zc (4 ) +derivl (2,1) *hz*v3 (3) + 

2  derivl (2, 2) *hz*v3 (3) +derivl (2, 3) *hz*v3 (3) + 

3  derivl (2, 4 ) *hz*v3 (3) 

aj (3,  3) =hzdt*v3 (3) 
c 

call  kmiriv3  (aj  ,  ajinv, det ) 

detwt  =  det  *  wx  *  wy  *  wz 

c  Compute  global  derivatives  and  strain-nodal  displacement  matrix 

do  902  i=l, 4 

derivg (1, i) =ajinv (1, 1) *derivl (1, i) +ajinv (1, 2) *derivl (2, i) 
derivg (2,  i) =ajinv (2, 1) *derivl (1, i) +ajinv (2, 2) *derivl (2, i) 
derivg (3, i) =ajinv (3, 1) *derivl (1, i) +ajinv (3, 2) *derivl (2, i) 
derilg (1,  i) =aj inv (1,3) *hzdt 
derilg (2,  i) =ajinv (2, 3) *hzdt 
derilg (3,  i) =aj inv (3, 3) *hzdt 

902  continue 

do  903  i=l, 6 
do  903  j=l, 24 
bmtx (i, j ) =0 . 0 

903  continue 

do  904  i=l, 4 
il= (i-1 ) *6+1 
i2=il+l 
i3=i2+l 
i4=i3+l 
i5=i4+l 
i6=i5+l 

gkl=derivg ( 1,  i) *hz+shapef (i) *derilg  ( 1, i) 
gk2=derivg (2,  i) *hz+shapef (i) *derilg (2, i) 
gk3=derivg (3, i) *hz+shapef (i) *derilg (3, i) 
c 

bmtx ( 1 , i 1 ) =deri vg ( 1 ,  i ) 
bmtx (1, i4 ) =gkl* (-v2 ( 1) ) 
bmtx (1, i5) =gkl*vl (1) 
bmtx (1, i6) =gkl*v3 (1 ) 


bmtx ( 2 , i2 ) =derivg { 2 , i ) 
bmtx (2, i4 ) =gk2* (-v2 (2 ) ) 
bmtx (2, i5) =gk2*vl (2) 
bmtx ( 2 , i 6 ) =gk2 * v3 ( 2 ) 
bmtx (3,  i3) =derivg (3, i) 
bmtx (3,  i4 ) =gk3* (-v2 (3) ) 

■ bmtx (3, i5) =gk3*vl (3) 
bmtx ( 3 , i 6 ) =gk3 * v3 ( 3 ) 
bmtx (4 , il) =derivg (2,  i) 
bmtx (4, i2) =derivg (1, i) 
bmtx (4 , i4 ) =gk2* (-v2 ( 1) ) +gkl* (-v2 (2) ) 
bmtx (4, i5) =gk2*vl (l)+gkl*vl (2) 
bmtx (4, i 6 ) =gk2*v3 (1) +gkl*v3 (2) 

■  bmtx (5, i2 ) =derivg (3, i) 
bmtx (5, i3) =derivg (2,  i) 
bmtx  (5,  i4 )  =gk3*  (-v2  (2)  )  +gk2*  (-v2  (3)  ) 
bmtx (5, 15) =gk3*vl (2) +gk2*vl (3) 
bmtx (5, i6) =gk3*v3 (2) +gk2*v3 (3)  , 

bmtx (6, il) =derivg (3, i) 
bmtx (6, i3) =derivg (1, i) 
bmtx ( 6 , 14 ) =gk3* (-v2 (1) ) +gkl* (-v2 (3) ) 
bmtx (6, 15) =gk3*vl (1) +gkl*vl (3) 
bmtx (6, 16) =gk3*v3 (1) +gkl*v3 (3) 

904  continue 

do  905  i=l, 6 

do  905  j=l, 24 

905  bmtxt ( j , i) =bmtx (i,  j ) 

c  Calculate  strain 

do  906  1=1, 6 
estrainp (i) =0 . 0 
do  906  j=l, 24 

estrainp (i) =estrainp (i) tbmtx (i,  j ) *edisp (j ) 

906  continue 

do  920  i=l, 6 
do  920  j=l,6 
rot (i,  j ) =rotall (i, j , ie) 

920  continue 

c  Transform  strain  to  local  coordinates  system 
do  907  i=l, 6 
estrain (i) =0 . 0 
do  907  j=l, 6 

estrain (i) =est rain (i) +rot (i, j ) * estrainp (i) 

907  continue 

c  Calculate  stress  using  plane-strain  formulas 

estress(l)  =  front* (estrain (1)  +  pois*estrain (2 ) ) 
estress(2)  =  front* (pois*estrain (1)  +  estrain (2)) 
estress(3)  =  ymod  *  estrain(3) 

estress(4)  =  gmod  *  estrain (4) 

estress(5)  =  sfac  *  gmod  *  estrain (5) 

estress(6)  =  sfac  *  gmod  *  estrain(6) 

c  Rotate  stresses  to  global  coordinates 
do  908  i=l, 6 
estressg (i) =0 . 0 
do  908  j=l, 6 
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estressg (i) =estressg (i) +rot ( j , i) *estress  ( j ) 


c  Find  eforceh  for  this  gauss  point  and  sum  to  element  force 
do  909  i=l, 24 
do  909  j=l, 6 

909  eforceh (i) =eforceh (i) +bmtxt ( i ,  j ) *estressg ( j ) *detwt 


c  ***  End  of  Integration  Loop 
910  continue 


c  Store  force  into  HG  Variables 
ftll (ie) =eforceh ( 1) 
ft 12 (ie) “eforceh (2) 
ft 13 (ie) =eforceh (3) 
fmll (ie) =eforceh (4 ) 
fml2 (ie) =eforceh (5) 
fml3 (ie) =eforceh ( 6) 
ft21 (ie) =eforceh (7 ) 
f t22 ( ie ) =ef orceh ( 8 ) 
ft23 (ie) =ef orceh (9) 
fm21 (ie) =eforceh (10) 
fm22 (ie) “eforceh (11) 
fm23 (ie) “eforceh (12) 
ft31 (ie) =ef orceh (13) 
ft 32 (ie) =eforceh (14 ) 
ft 33 (ie) =eforceh (15) 
fm31 (ie) “eforceh (16) 
fm32 (ie) “eforceh (17) 
fm33 (ie) “eforceh (18) 
ft41 (ie) “eforceh (19) 
ft42 (ie) “eforceh (20) 
ft43 (ie) “eforceh (21) 
fm41 (ie)=eforceh (22) 
fm42 (ie) “eforceh (23) 
fm43 (ie) “eforceh (24) 
c  ***  End  of  Element  Loop 
900  continue 

c  Other  methods 
else 

do  200  i=lft, lit 
fml3 (i) =0 . 0 
fm23 (i) =0 . 0 
fm33 (i) =0 . 0 
fm43 (i) =0 . 0 
200  continue 


c  Traditional  Hour  Glass  Force 
tmode=qhg*ymod/1920 . 0 
wmode=qhg*gmod/120 . 00 
xmmode=qhg*ymod/80 .000 
do  10  i=lft , lit 
x2(i)  =glll (i) *x21 (i) 
y2(i)  =gll2 (i) *x21 (i) 
x3(i)  =glll (i) *x31 (i) 
y3(i)  =gll2 (i) *x31 (i) 
x4(i)  =glll (i) *x41 (i) 
y4(i)  =gll2 (i) *x41 (i) 
htx (i) =area (i) * (x3  (i) 
hty (i) =area (i) * (y3 (i) 


Calculation 


+gl21 (i)*y21 (i)  +gl31 (i) *z21 (i) 
+gl22(i)*y21(i)  +gl32 (i) *z21 (i) 
+gl21(i)*y31(i)  +gl31 (i) *z31 (i) 
+gl22(i)*y31(i)  +gl32 (i) *z31  (i) 
+gl21(i)*y41(i)  +gl31 (i) *z41 (i) 
+gl22(i)*y41(i)  +gl32 (i) *z41 (i) 
-x2(i)-x4 (i) ) 

-y2(i)-y4 (i) ) 
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gml(i)=  1 . -pxl (i) *htx (i) -pyl (i) *hty (i) 
gm2 (i) =-l . -px2 (i) *htx (i) -py2 (i) *hty (i) 
gm3(i)=  2.-gml(i) 
gm4 ( i ) =— 2 . -gm2 ( i ) 

10  continue 

if  (ifsv.eq.3)  then 
do  20  i=lft, lit 

bsum{i)  =2 . * (pxl (i) **2+px2 (i) **2+pyl (i) **2+py2 (i ) **2 ) 

xl  (i)  =area  (i)  *bsuin(i)  *thick(i) 

cl (i) =xl (i) *thick (i) **2 

c2 (i) =wmode*cl (i) *area (i) 

c3 ( i ) =xmmode*xl ( i ) 

cl (i) =tmode*cl (i) 

20  continue 
else 

hgfac=qhg*rhoa (1ft) *sndspd/ (dtl+1 . e-20 ) 
do  30  i=lft,llt 

c3 (i) =hgfac*sqrt (sarea (i) ) *thick(i) 
c2(i)=c3(i) 

cl (i)=.05*c3(i) *thick(i) 

30  .  continue 

endif 

do  40  i=lft, lit 

qhx  (i)  =gml  (i)  *vxl  (i)  +gm2  (i)  *vx2  (i)  +gm3  (i)  *vx3  (i)  +gm4  (i)  *vx4  (i) 
qhy ( i ) =gml ( i ) * vyl ( i ) +gm2 ( i ) * vy2 ( i ) +gm3 ( i ) * vy3 ( i ) +gm4 ( i ) * vy4 ( i ) 
qwz  (i)  =gml  (i)  *vzl  (i)  +gm2  (i)  *vz2  (i)  +gm3  (i)  *vz3  (i)  +gm4  (i)  *vz4  (i) 
qtx  (i)  =gml  (i)  *vx5  (i)  +gm2  (i)  *vx6  (i)  +gm3  (i)  *vx7  (i)  +gm4  (i)  *vx8  (i) 
qty  { i )  =gml  ( i )  *vy5  ( i )  +gm2  ( i )  * vy6  ( i ).  +gm3  ( i )  * vy7  ( i )  +gm4  ( i )  * vy8  ( i ) 
40  continue 

if  (ifsv.ne.3)  then 
do  50  i=lft, lit 
qs(l,i)=0. 

qs  (2,  i)  =0 .  ‘ 

qs  (3,  i)  =0 . 
qs  (4 ,  i) =0 . 
qs  (5,  i) =0 . 

50  continue 
endif 

do  60  i=lft, lit 
qs  ( 1,  i)  =qs  (1,  i) +c3  (i)  *qhx  (i) 
qs ( 2 , i ) =qs ( 2 , i ) +c3 ( i ) *qhy ( i ) 
qs  (3,  i)  =qs  (3,  i) +c2  (i)  *qwz  (i) 
qs (4,  i) =qs (4 , i) +cl (i) *qtx (i) 
qs (5, i)=qs (5, i) +cl (i) *qty (i) 
ft31 (i) =gm3 (i) *qs (1, i) 
ft32 (i) =gm3 (i) *qs (2, i) 
ft33 (i) =gm3 (i) *qs (3, i) 
ft41 (i) =gm4 (i) *qs (1, i) 
ft42  (i)  =gm4  (i)  *qs  (2,  i) 
ft43  (i)  =gm4  (i)  *qs  (3,  i) 
ft  11  (i)  =gml  (i)  *qs  (1,  i) 
ftl2 (i) =gml (i) *qs  (2, i) 
ftl3 (i) =gml (i) *qs (3, i) 
ft21 (i)=gm2 (i) *qs (1, i) 
ft22 (i)=gm2 (i) *qs (2, i) 
ft23 (i) =gm2 (i) *qs (3, i) 
fmll (i)=gml (i) *qs (4, i) 
fml2  (i)  =gml  (i)  *qs  (5,  i) 
fm21  (i)  =gm2  (i)  *qs  (4,  i) 
fm22  (i)  =gm2  (i)  *qs  (5,  i) 
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fm31 (i) =gm3 (i) *qs (4, i) 
fm32  (i)  =gm3  (i)  *qs  (5,  i) 
fm41 (i)=gm4 (i)*qs (4,i) 
fm4  2  (i)  =gm4  (i)  *qs  (5,  i) 

60  continue 
endif 
else 

***  No  Hourglass  Control 
do  70  i=lft,llt 
ft31 (i) =0 . 0 
ft32 (i) =0 . 0 
ft33 (i) =0 . 0 
ft41 (i) =0 . 0 
ft42 (i) =0 . 0 
ft43 (i) =0 . 0 
ftll (i) =0 . 0 
ftl2 (i) =0 . 0 
ftl3 (i) =0 . 0 
ft21 (i) =0 . 0 
ft22 (i) =0 . 0 
ft23 (i) =0 . 0 
fmll (i) =0 . 0 
fml2 (i) =0 . 0 
fml3 (i) =0 . 0 
fm21 (i) =0 . 0 
fm22 (i) =0 . 0 
fm23 (i) =0 . 0 
fm31 (i) =0 . 0 
fm32 (i) =0 . 0 
fm33 (i) =0 . 0 
fm41 (i) =0 . 0 
fm42 (i) =0. 0 
fm4  3 ( i ) =0 . 0 
70  continue 
endif 

Total  Element  forces  on  its  nodes 
if (method. ne. 5)  then 
do  80  i=lft,llt 

fxl (i) =glll (i) *ftll (i) +gll2 (i) *ftl2 (i) +gll3 (i) *ftl3 (i) +sf 1 (i, 1 ) 
fyl (i) =gl21 (i)*ftll (i)+gl22 (i) *ftl2 (i)+gl23 (i) *ftl3 (i)+sf2 (i, 1) 
fzl (i) =gl31 (i) *ftll (i) +gl32 (i) *ftl2 (i)+gl33 (i) *ftl3 (i)+sf3 (i, 1) 
fx2  (i)  =glll  (i)  *ft21  (i)  +gll2  (i)  *ft22  (i)  +gll3  (i)  *ft23  (i)  +sf  1  (i,  2  ) 
fy2 (i)=gl21(i) *ft21 (i)+gl22 (i) *ft22 (i)+gl23 (i) *ft23 (i)+sf2 (i,2) 
f z2 (i) =gl31 (i)*ft21(i)+gl32(i)*ft22(i) +gl33 (i)*ft23(i)+sf3(i,2) 
fx3(i)=glll(i)*ft31(i)+gll2(i)*ft32(i)+gll3(i)*ft33(i)+sfl(i,3) 
fy3 (i) =gl21 (i) *ft31 (i)+gl22 (i) *ft32 (i)+gl23 (i) *ft33 (i)+sf2 (i,3) 
fz3 (i) =gl31 (i)*ft31(i)+gl32(i)*ft32(i)+gl33(i)*ft33(i)+sf3(i,3) 
fx4 (i)=glll(i)*ft41(i)+gll2(i)*ft42(i)+gll3(i)*ft43(i)+sfl(i,4) 
fy4 (i)=gl21(i)*ft41(i)+gl22(i)*ft42(i)+gl23(i)*ft43(i)+sf2(i,4) 
fz4 (i) =gl31 (i) *ft41 (i)+gl32 (i) *ft42 (i)+gl33 (i)*ft43 (i)+sf3(i, 4) 
xmxl (i) =glll (i) *fmll (i)+gll2 (i) *fml2 (i)+gll3 (i) *fml3(i)+sf4 (i, 1) 
xmyl (i)=gl21 (i) *fmll (i)+gl22 (i) *fml2 (i)+gl23 (i) *fml3 (i) +sf5 (i, 1) 
xmzl (i) =gl31 (i) *fmll (i)+gl32 (i) *fml2 (i)+gl33 (i) *fml3 (i) +sf6 (i, 1) 
xmx2 (i)=glll (i) *fm21 (i)+gll2 (i) *fm22 (i)+gll3(i) *fm23 (i)+sf4 (i,2) 
xmy2 (i) =gl21 (i) *fm21 (i) +gl22 (i) *fm22 (i) +gl23 (i) *fm23 (i) +sf 5  (i, 2) 
xmz2 (i) =gl31 (i)*fm21 (i)+gl32 (i) *fm22 (i)+gl33 (i) *fm23 (i) +sf 6 (i, 2) 
xmx3 (i) =glll (i) *fm31 (i) +gll2 (i) *fm32 (i) +gll3 (i) *fm33 (i) +sf 4 (i,3) 
xmy3 (i) =gl21 (i) *fm31 (i) +gl22 (i) *fm32 (i) +gl23 (i) *fm33 (i) +sf 5 (i, 3) 
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xmz3 (i) =gl31 (i) *fm31 (i) +gl32 (i) *fm32 (i) +gl33 (i) *fm33 (i) +sf 6 (i, 3) 
xmx4 (i) =glll (i) *fm41 { i ) +gll2 (i) *fm42 (i) +gll3 (i) *fm43 (i) +sf4 (i, 4 ) 
xmy4 (i) =gl21 (i) *fm41 (i) +gl22 (i) *fm42 (i)+gl23 (i) *fm43 (i)+sf5(i,  4) 
xmz4 (i) =gl31 (i) *fm41 (i) +gl32 (i) *fm42 (i) +gl33 (i ) *fm43 (i)+sf6(i,4) 
80  continue 
else 

do  400  i=lft, lit 

f x  1 (i)  =glll (i) *ftll (i) +gll2 (i) *ftl2 (i) +gll3 (i) *ftl3  (i) 
fyl (i) =gl21 (i) *ftll (i) +gl22 (i) *ftl2 (i) +gl23 (i) *ftl3 (i) 
f zl (i) =gl31 (i) *ftll (i) +gl32 (i) *ftl2 (i) +gl33 (i) *ftl3 (i) 
fx2 (i) =glll (i) *ft21 (i) +gll2 (i) *ft22 (i) +gll3 (i) *ft23 (i) 
fy2 (i)=gl21 (i) *ft21 (i) +gl22 (i) *ft22 (i) +gl23 (i) *ft23 (i) 
fz2 (i) =gl31 (i) *ft21 (i) +gl32 (i) *ft22 (i) +gl33 (i) *ft23 (i) 
fx3 (i) =glll (i) *ft31 (i) +gll2 (i) *ft32 (i) +gll3 (i) *ft33 (i) 
fy3 (i) =gl21 (i)*ft31 (i) +gl22 (i) *ft32 (i) +gl23 (i) *ft33 (i) 
fz3 (i) =gl31 (i) *ft31 (i) +gl32 (i) *ft32 (i) +gl33 (i) *ft33 (i) 
fx4 (i) =glll (i) *ft41 (i) +gll2 (i)*ft42 (i)+gll3(i) *ft43 (i) 
fy4 (i)=gl21 (i) *ft41 (i)+gl22 (i) *ft42 (i)+gl23(i) *ft43 (i) 
fz4(i)=gl31(i)*ft41(i)+gl32(i)*ft42(i)+gl33(i)*ft43(i) 
xmxl (i) =glll (i) *fmll (i) +gll2 (i) *fml2 (i) +gll3 (i) *fml3 (i) 
xmyl (i) =gl21 (i) *fmll (i) +gl22 (i) *fml2 (i) +gl23 (i) *fml3 (i) 
xmzl (i) =gl31 (i) *fmll (i) +gl32 (i) *fml2 (i) +gl33 (i) *fml3  (i) 
xmx2 (i) =glll (i) *fm21 (i) +gll2 (i) *fm22 (i) +gll3 (i) *fm23 (i) 
xmy2 (i) =gl21 (i) *fm21 (i) +gl22 (i) *fm22 (i)+gl23 (i) *fm23 (i) 
xmz2 (i)=gl31 (i)*fm21 (i)+gl32 (i) *fm22 (i) +gl33 (i) *fm23 (i) 
xmx3 (i) =glll (i) *fm31 (i) +gll2 (i) *fm32 (i) +gll3 (i) *fm33 (i) 
xmy3 (i) =gl21 (i) *fm31 (i) +gl22 (i) *fm32 (i) +gl23 (i) *fm33 (i) 
xmz3 (i)=gl31 (i) *fm31 (i) +gl32 (i) *fm32 (i) +gl33 (i) *fm33 (i) 
xmx4 (i) =glll (i) *fm41 (i) +gll2 (i) *fm42 (i) +gll3 (i) *fm43 (i) 
xmy4 (i) =gl21 (i) *fm41 (i)+gl22 (i) *fm42 (i) +gl23 (i) *fm43 (i) 
xmz4 (i) =gl31 (i) *fm41 (i) +gl32 (i) *fm42 (i) +gl33 (i) *fm43 (i) 

400  continue 

do  405. i=lft,llt 

fxl  (i)  =sf  1  (i,  1)  +hour  (i)  *  (fxl  (i)  -sf  1  (i,  1) ) 
fyl  (i)  =sf2  (i,  1) +hour  (i)  *  (fyl  (i) -sf2  (i,  1)  ) 
fzl (i) =sf3 (i, 1) +hour (i)*(fzl(i)-sf3(i,l)) 
fx2 (i) =sf 1 (i, 2} +hour (i) * (fx2 (i) -sf 1 (i, 2) ) 
fy2 (i) =sf2 (i,  2) +hour (i) * (fy2 (i) -sf2 (i, 2) ) 
fz2  (i)  =sf3  (i,  2)  +hour  (i)  *  (fz2  (i)  -sf3  (i,  2)  ) 
fx3 (i) =sfl (i, 3) +hour (i) * (fx3 (i) -sfl (i, 3) ) 
fy3  (i)  =sf2  ( i 3)  +hour  (i)  *  (fy3  (i)-sf2(i,3)) 
fz3 (i) =sf3 (i, 3) +hour (i) * (f z3 (i) -sf3 (i, 3) ) 
fx4 (i) =sf 1 (i, 4 ) +hour (i)*(fx4(i)-sfl(i,4)) 
fy4  (i)  =sf2  (i,  4 )  +hour  (i)  *  (fy4  (i) -sf2  (i,  4 )  ) 
f z4 (i) =sf 3 (i, 4 ) +hour (i) * ( f z4 (i) -sf3 (i, 4 ) ) 
xmxl (i) =sf4 (i, 1) +hour ( i ) * (xmxl (i) -sf4 (i, 1) ) 
xmyl (i) =sf5 (i, 1) +hour (i) * (xmyl (i) -sf5 (i,  1) ) 
xmzl (i) =sf6 (i, 1) +hour (i) * (xmzl (i) -sf 6 (i, 1) ) 
xmx2 (i) =sf4 (i, 2) +hour ( i ) * (xmx2 (i) -sf4 (i,  2) ) 
xmy2 (i) =sf5 (i, 2) +hour (i) * (xmy2 (i) -sf5 (i,  2)  ) 
xmz2 (i) =sf 6 (i, 2) +hour (i) * (xmz2 (i)-sf6(i,2)) 
xmx3  (i)  =sf4  (i,  3) +hOur  (i)  *  (xmx3  (i) -sf4  (i,  3)  ) 
xmy3 (i) =sf 5 (i, 3) +hour (i) * (xmy3 (i) -sf5 (i, 3) ) 
xmz3 (i) =sf 6 (i, 3) +hour (i) * (xmz3 (i) -sf 6 (i, 3) ) 
xmx4 (i) =sf 4 (i, 4 ) +hour (i) * (xmx4 (i) -sf 4 (i,  4 )  ) 
xmy4 (i) =sf 5 (i, 4 ) +hour (i) * (xmy4 (i) -sf 5 (i,  4 ) ) 
xmz4 (i) =sf 6 (i, 4 ) +hour (i) * (xmz4 (i) -sf 6 (i, 4 ) ) 

405  continue 
endif 
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c  Apply  drilling  moments  for  contact  forces 
call  kmdrill (e, f , ndlist, nlstm) 

c  Put  nodal  forces  into  system  force  vector 
if  (ishlf.ne.l)  then 
c  No  element  failure 

do  90  i=lft, lit 
e  ( 1,  ixl  (i)  )  =e  ( 1,  ixl  (i)  ) -fxl  (i) 
e  (2 ,  ixl  (i)  ) =e  (2,  ixl  (i)  )  -  fyl  (i) 
e  (3,  ixl  (i)  )=e  (3,  ixl  (i)  ) -fzl  (i) 
f ( 1 ,  ixl ( i ) ) =f ( 1 , ixl ( i ) ) -xmxl ( i ) 
f ( 2 , ixl ( i ) ) =f ( 2 , ixl ( i ) ) -xmyl ( i ) 
f  (3,  ixl  (i)  )  =f  (3,  ixl  (i)  )  -xmzl  (i) 
e  (1,  ix2  (i)  )  =e  (1,  ix2  (i)  )  -fx2  (i) 
e  (2,  ix2  (i)  )  =e  (2,  ix2  (i)  )  -fy2  (i) 
e  (3,  ix2  (i)  )  =e  (3,  ix2  (i)  )  -f  z2  (i) 
f ( 1 ,  ix2 ( i ) ) =f ( 1 , ix2 ( i ) ) -xmx2 ( i ) 
f ( 2 , ix2 ( i ) ) =f ( 2 , ix2 ( i ) ) -xmy2 ( i ) 
f  (3,  ix2  (i)  )  =f  (3,  ix2  (i)  )  -xmz2  (i) 
e (1,  ix3 (i) ) =e ( 1, ix3 (i) ) -fx3 (i) 
e  (2,  ix3  (i)  )  =e  (2,  ix3  (i)  )  -fy3  (i) 
e  (3,  ix3  (i)  )  =e  (3,  ix3  (i)  )  -fz3  (i) 
f ( 1 , ix3 ( i ) ) =f ( 1 , ix3 ( i ) ) -xmx3 ( i ) 
f ( 2 , ix3 ( i ) ) =f ( 2 , ix3 ( i ) ) -xmy3 ( i ) 
f ( 3 , ix3 ( i ) ) =f ( 3 , ix3 ( i ) ) -xmz3 ( i ) 
e ( 1 , ix4 ( i ) ) =e ( 1 , ix4 ( i ) ) -f x4 ( i ) 
e  (2,  ix4  (i)  )  =e  (2,  ix4  (i)  )  -fy4  (i) 
e  (3,  ix4  (i)  )  =e  (3,  ix4  (i)  )  -f  z4  (i) 
f ( 1 ,  ix4 ( i ) ) =f ( 1 , ix4 { i ) ) -xmx4 ( i ) 
f  (2,  ix4  (i)  )*=f  (2,  ix4  (i)  ) -xmy4  (i) 
f  (3,  ix4  (i)  )  =f  (3,  ix4  (i)  )  -xmz4  (i)  • 

90  continue 

else 

c  With  Element  Failure 

ifail=l 

do  100  i=lft, lit 

e  (1,  ixl  (i)  )  =e  (1,  ixl  (i)  )  -fail  (i)  *fxl  (i) 
e  (2,  ixl  (i)  )  =e  (2,  ixl  (i)  )  -fail  (i)  *fyl  (i) 
e  (3,  ixl  (i)  )  =e  (3,  ixl  (i)  )  -fail  (i)  *fzl  (i) 
f (1, ixl (i) )=f (1, ixl (i) ) -fail (i) *xmxl (i) 
f (2, ixl (i) ) =f (2, ixl (i) ) -fail (i) *xmyl (i) 
f (3, ixl (i) ) =f (3, ixl (i) ) -fail (i) *xmzl (i) 
e  ( 1,  ix2  (i)  )  =e  ( 1,  ix2  (i)  )  -fail  (i)  *fx2  (i) 
e  (2,  ix2  (i) )  =e  (2,  ix2  (i)  )  -fail  (i)  *fy2  (i) 
e (3, ix2 (i) )=e (3, ix2 (i) ) -fail (i) *fz2 (i) 
f  ( 1,  ix2  (i) )  =f  ( 1,  ix2  (i)  )  -fail  (i)  *xmx2  (i) 
f  (2,  ix2  (i)  )  =f  (2,  ix2  (i)  )  -fail  (i)  *xmy2  (i) 
f  (3,  ix2  (i) )  =f  (3,  ix2  (i)  )  -fail  (i)  *xmz2  (i) 
e  (1,  ix3  (i)  )  =e  (1,  ix3  (i)  )  -fail  (i)  *fx3  (i) 
e  (2,  ix3  (i)  )  =e  (2,  ix3  (i)  )  -fail  (i)  *fy3  (i) 
e  (3,  ix3  (i) )  =e  (3,  ix3  (i)  )  -fail  (i)  *fz3  (i) 
f ( 1,  ix3 (i) ) =f ( 1, ix3 (i) ) -fail (i) *xmx3 (i) 
f (2, ix3 (i) ) =f (2, ix3 (i) ) -fail (i) *xmy3 (i) 
f  (3,  ix3  (i)  )  =f  (3,  ix3  (i)  )  -fail  (i)  *xmz3  (i) 
e  (1,  ix4  (i)  )  =e  (1,  ix4  (i)  )  -fail  (i)  *fx4  (i) 
e  (2,  ix4  (i)  )  =e  (2,  ix4  (i)  )  -fail  (i)  *fy4  (i) 
e  (3,  ix4  (i)  )  =e  (3,  ix4  (i)  )  -fail  (i)  *f  z4  (i) 


f  ( 1,  ix4  (i)  )  =f  (1,  ix4  (i)  )  -fail  (i)  *xmx4  (i ) 
f (2,  ix4 (i) )=f (2, ix4 (i) ) -fail (i) *xmy4 (i) 
f  (3,  ix4  (i)  )  =f  (3,  ix4  (i)  )  -fail  (i)  *xmz4  (i) 

100  continue 
endif 

if  (output)  then 
nblksz=nlq 
nwords=12*nblksz 
call  blkcpy (fxl, savfrc, nwords) 
ndof=4 

if  (ifail.eq.l)  call  blkcpy  (fail, svfail, nlq) 
endif 
return 
end 
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subroutine  kmtran 

implicit  double  precision  (a-h,o-z) 
include  'nlqpar.inc' 

Computes  B  matrix  based  on  Belytschko-Tsay  shell  element  heeded  for 
hourglass  control  of  Kwon-McDermott  shell  element.  Also  computes 
area  for  time-step  control 

common/bk02/iburn, isdo, dtl,  dt2 
common/aux5/ 

lblvx (nlq) , blvy (nlq) ,blvz (nlq) , b2vx (nlq) ,  b2vy (nlq) ,  b2vz (nlq) , 
2bltx (nlq) ,blty (nlq) ,b2tx (nlq) , b2ty (nlq) , bxyv (nlq)  , bxyt (nlq)  , 
3epyz (nlq) , epzx (nlq) 
common/aux7/ 

1  vxl (nlq) , vx2 (nlq) , vx3 (nlq) , vx4 (nlq)  , 

2  vx5 (nlq) , vx6 (nlq) , vx7 (nlq) ,  vx8 (nlq) , 

3  vyl (nlq) , vy2 (nlq) ,vy3 (nlq) ,  vy4 (nlq) , 

4  vy5 (nlq) , vy6 (nlq) , vy7 (nlq) ,  vy8 (nlq)  , 

5  vzl (nlq) , vz2 (nlq) , vz3 (nlq) ,  vz4 (nlq) , 

6  vz5 (nlq) , vz6 (nlq) , vz7 (nlq) , vz8 (nlq) 
common/auxlO/area (nlq) , 

1  pxl (nlq) , px2 (nlq) ,px3 (nlq) ,px4 (nlq) , 

&  px5 (nlq) ,px6 (nlq) ,px7 (nlq) ,px8 (nlq) , 

2  pyl (nlq) ,py2 (nlq) ,py3 (nlq) ,py4 (nlq) , 

&  py5 (nlq) ,py6 (nlq) ,py7 (nlq) ,py8 (nlq) , 

3  pzl (nlq) ,pz2 (nlq) ,pz3 (nlq) ,pz4 (nlq) , 

&  pz5 (nlq) ,pz6 (nlq) ,pz7 (nlq) ,pz8 (nlq)  , 

4  dxl (nlq) , dx2 (nlq) , dx3 (nlq) , dx4 (nlq)  , 

5  dx5 (nlq) , dx6 (nlq) , dx7 (nlq) , dx8 (nlq)  , 

6  dyl (nlq) , dy2 (nlq) ,dy3 (nlq) , dy4 (nlq)  , 

7  dy5 (nlq) , dy6 (nlq) , dy7 (nlq) , dy8 (nlq)  , 

8  dzl (nlq) , dz2 (nlq) , dz3 (nlq) , dz4 (nlq)  , 

9  dz5 (nlq) , dz6 (nlq) , dz7 (nlq) , dz8 (nlq) 
common /auxll/ 

&gmll (nlq) , gml2 (nlq) , gml3 (nlq) , gm21 (nlq) ,  gm22 (nlq)  ,  gm23 (nlq)  , 
&gm31 (nlq) , gm32 (nlq) , gm33 (nlq) ,pxla (nlq) ,pyla (nlq) ,px2a (nlq) , 
&py2a (nlq) , diagl (nlq) , diag2 (nlq) 
common/auxl3/ 

&zeta (nlq) , thick (nlq) , fga (nlq) , fgb (nlq) ,  fgc (nlq)  , 

&glll (nlq) , gll2 (nlq) , gll3 (nlq) , gl21 (nlq) , gl22 (nlq) ,  gl23 (nlq) , 
&gl31 (nlq) , gl32 (nlq) , gl33 (nlq) , 

&xl (nlq)  ,  yl (nlq) , zl (nlq) , x2 (nlq) , y2 (nlq) , z2 (nlq) , 

&x3 (nlq) , y3 (nlq) , z3 (nlq) , x4 (nlq) , y4 (nlq) ,  z4 (nlq) 
common/auxl2/ 

1  wxxl (nlq) , wxx2 (nlq) , wxx3 (nlq) , wxx4 (nlq) , 

2  wyyl (nlq) , wyy2 (nlq) , wyy3 (nlq)  ,  wyy4 (nlq)  , 

3  wzzl (nlq) , wzz2 (nlq) , wzz3 (nlq) , wzz4 (nlq)  , 

4  al3 (nlq) , a23 (nlq) , a33 (nlq) 
common/aux36/lft, lit 
common/aux40/ 

&x31 (nlq) , y31 (nlq) , z31 (nlq) , x42 (nlq)  ,  y42 (nlq)  ,  z42  (nlq) , 

&x21 (nlq)  ,  y21 (nlq) , z21 (nlq) , cl (nlq) , c2 (nlq)  ,  c3 (nlq)  ,  xl (nlq) , 

&x41 (nlq) , y41 (nlq) , z41 (nlq) 

common/sound/sndspd, sndsp (nlq) , diagm (nlq)  ,  sarea (nlq) , dxl (nlq) 
common/sides/sidmn (nlq) 
common/double/iprec, ncpw, unit 

dimension  vxl3 (nlq) , vx24 (nlq) , vyl3 (nlq) ,  vy24 (nlq) , 

1  vzl3 (nlq) , vz24 (nlq) , wxxl3 (nlq) , wxx24 (nlq) , wyyl3 (nlq) , 
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2  wyy24 (nlq) , sidem (nlq) , xt2 (nlq) , yt2 (nlq) , xt3 (nlq) , yt3 (nlq) , 

3  xt4 (nlq) , yt4 (nlq) 

equivalence  (wxxl,vxl3), (wxx2,vx24), (wxx3,vyl3), (wxx4,vy24), 

1  (wyyl,wxxl3) ,  (wyy2, wxx24) ,  (wyy3,wyyl3)  ,  (wyy4,wyy24) , 

2  (wzzl,vzl3) , (wzz2,vz24) 


do  10  i=lft, lit ' 
gmll (i) =dtl*glll (i) 
gm21 (i) =dtl*gl21 (i) 
gm31 (i)=dtl*gl31 (i) 
gml2 (i) =dtl*gll2 (i) 
gm22 (i)=dtl*gl22 (i) 
gm32 (i)=dtl*gl32 (i) 
gml3 (i) =dtl*gll3 (i) 
gm23 (i) =dtl*gl23 (i) 
gm33(i)=dtl*gl33(i) 

vxl (i)=gmll (i) *dxl (i)  +gm21 (i) *dyl (i) 
vyl (i) =gml2 (i) *dxl (i)  +gm22 (i) *dyl (i) 
vzl (i)=gml3 (i) *dxl (i)  +gm23 (i) *dyl (i) 
vx2 (i) =gmll (i) *dx2 (i)  +gm21 (i) *dy2 (i) 
vy2 (i) =gml2  (i) *dx2 (i)  +gm22 (i) *dy2 (i) 
vz2 (i) =gml3 (i) *dx2 (i)  +gm23 (i) *dy2 (i) 
vx3 (i) =gmll (i) *dx3 (i)  +gm21 (i) *dy3 (i) 
vy3 (i) =gml2 (i) *dx3 (i)  +gm22 (i) *dy3 (i) 
vz3 (i) =gml3 (i) *dx3 (i)  +gm23 (i) *dy3 (i) 
10  continue 


+gm31 (i) *dzl (i) 
+gm32 (i) *dzl (i) 
+gm33 (i) *dzl (i) 
+gm31 (i) *dz2 (i) 
+gm32 (i) *dz2 (i) 
+gm33 (i) *dz2 (i) 
+gm31 (i) *dz3 (i) 
+gm32 (i) *dz3 (i) 
+gm33 (i) *dz3 (i) 


do  20  i=lft, lit 

vx4 (i) =gmll (i) *dx4 (i)  +gm21 (i) *dy4 (i)  +gm31 (i) *dz4 (i) 
vy4 (i)=gml2 (i) *dx4 (i)  +gm22 (i) *dy4 (i)  +gm32 (i) *dz4 (i) 
vz4 (i)=gml3 (i) *dx4 (i)  +gm23 (i) *dy4 (i)  +gm33 (i) *dz4 (i) 
vx5 ( i ) =gml 1 ( i ) *wxxl (i)+gm21 (i) *wyyl (i) +gm31 (i) *wzzl (i) 
vy5 (i) =gml2 (i) *wxxl (i) +gm22 (i) *wyyl (i) +gm32 (i) *wzzl (i) 
vx6 (i) =gmll (i) *wxx2 (i) +gm21 (i) *wyy2 (i) +gm31 (i) *wzz2 (i) 
vy6 (i) =gml2 (i) *wxx2 (i) +gm22 (i) *wyy2 (i) +gm32 (i) *wzz2 (i) 
vx7 (i)=gmll (i) *wxx3 (i) +gm21 (i) *wyy3 (i) +gm31 (i) *wzz3 (i) 
vy7 (i)=gml2 (i) *wxx3 (i) +gm22 (i) *wyy3 (i)+gm32 (i) *wzz3 (i) 
vx8  (i)  =gmll  (i)  *wxx4  (i)  +gm21  (i)  *wyy4  (i)  +gm31  (i)  *wzz4  (i) 
vy8 (i) =gml2 (i) *wxx4 (i) +gm22 (i) *wyy4 (i)+gm32 (i) *wzz4 (i) 
xt2(i)  =glll (i) *x21 (i)  +gl21 (i) *y21 (i)  +gl31 (i) *z21 (i) 
yt2(i)  =gll2 (i) *x21 (i)  +gl22 (i) *y21 (i)  +gl32 (i) *z21 (i) 
xt3(i)  =glll (i) *x31(i)  +gl21 (i) *y31 (i)  +gl31 (i) *z31 (i) 
yt3(i)  =gll2 (i) *x31 (i)  +gl22 (i) *y31 (i)  +gl32 (i) *z31 (i) 
xt4(i)  =glll (i) *x41 (i)  +gl21 (i) *y41 (i)  +gl31 (i) *z41 (i) 
y 1 4  ( i )  =gll2 (i) *x41(i)  +gl22 (i) *y41 (i)  +gl32 (i) *z41 (i) 
20  continue 


do  30  i=lft,llt 
pxl(i)  =  . 5* (yt2 (i)-yt4 (i) ) 

px2(i)  =  .5*  yt3 (i) 
pyl(i)  =-. 5* (xt2 (i) -Xt4 (i) ) 
py2(i)  =-.5*  xt3(i) 

sarea (i) =2 . 0* (py2 (i) *pxl (i) -pyl (i) *px2 (i) ) 

diagl (i) =xt3 (i) **2+yt3 (i) **2 

diag2(i)=4.*(pxl(i)*pxl(i)+pyl(i)*pyl(i) ) 

diagm(i)=  max (diagl (i)  , diag2 (i) ) 

sidel  =xt2 (i) *xt2 (i) +yt2 (i) *yt2 (i) 

side2  =(xt3 (i) -xt2 (i) ) **2+ (yt3 (i) -yt2 (i) ) **2 

side3  =(xt4 (i) -xt3 (i) ) **2+ (yt4 (i)-yt3 (i) ) **2-l.e-14 

side4  =xt4 (i) *xt4 (i) +yt4 (i) *yt4  (i) 
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sida3  =side4* (5 . -sign ( . 5*unit, side3) ) +side3 
sidmn (i) =  min (sidel, side2, sida3, side4 ) 
sidem (i) =  max (sidel, side2, side3, side4 ) * 

1  ( . 625+sign ( . 375*unit,  side3) ) 

fgb(i)  =sarea (i) *fgb (i) 

30  continue 


do  40  i=lft, lit 
area (i) =1 . / (sarea (i) +1 .e-20) 
sarea(i)  =  sarea(i)  *  sqrt (2 . 0*thick (i) ) 
40  continue 
c 

if  (isdo.eq.0.or.isdo.eq.2)  then 
do  50  i=lft, lit 

50  diagm(i)=  min(diagm(i) , sidem(i) ) 
return 
else 
return 
endif 

end 
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subroutine  kwnmcd(rule, ixp, x, rhs, vt, vr, strain, yhatn, fibl, 

1  auxvec, mtype, ro, cm, csprop, nsubgv,mtnum, nfegp, ihgq, hgq, xies, ener, 

2  mpusr, lav, nmel, nnml,mxe, iblks, dampk, ym,prv, emain) 
implicit  double  precision  (a-h,o-z) 

include  ' nlqpar.inc' 

***************************  *  *  ****************************** 
main  subroutine  for  the  kwon-mcdermott  shell  formulation 

(Call  parameters  are  same  as  all  other  shell  formulations) 

McDermott  1999 

************************************  *  *  ********************** 
common/  /b ( 1 ) 

common/bkOO/numnp, numpc, numlp, neq, ndof , nlcur, numcl, numvc, 

1  ndtpts, nelmd, nmmat, numelh, numelb, numels, numelt, numdp, 

2  grvity, idirgv, nodspc, nspcor 
common/bk02/iburn,  isdo,  dtl ,  dt2 
common/bkl2/bl2,b2, qhg 

common/bkl3/lc0, lclh, Iclb, lcls, lclt, lc2, lc3, lc4 , lc5, lc6, lc7, lc9, 

1  lclO,  lcll, lcl2, lcl3, lcl4 , lcl5, lcl6, lcl7, lcl8 , lbO, lbl, lb2, 

2  lc7a, lc7b 

common/bkl9/nconst (60) , lenma,ncneos (15) 
common/bk25/dfavg, detavg, davg, iflg, ielmtc, ityptc 
common/auxOl/ 

&ftll (nlq) , ftl2 (nlq) , ftl3 (nlq) , ft21 (nlq) , ft22 (nlq) ,  ft23 (nlq) , 

&fmll (nlq) , fml2 (nlq) , fm21 (nlq) , fm22 (nlq) , 

&fm31 (nlq) , fm32 (nlq) , fm41 (nlq) , fm42 (nlq) , 

&fmrll (nlq) , fmrl2 (nlq) , fmr21 (nlq) , fmr22 (nlq) , fmr31 (nlq) , 

&fmr32 (nlq) , fmr41 (nlq) , fmr42 (nlq) , sg5 (nlq) , sg6 (nlq) 
common/aux2/dl (nlq) , d2 (nlq) , d3 (nlq) , d4 (nlq) , d5 (nlq)  ,  d6 (nlq) , 

1  wzzdt (nlq) , wyydt (nlq) , wxxdt (nlq) , einc (nlq) 
common/aux7/ 

1  vxl (nlq) , vx2 (nlq) , vx3 (nlq) , vx4 (nlq) , 

2  vx5 (nlq) , vx6 (nlq) , vx7 (nlq) ,  vx8 (nlq) , 

3  vyl (nlq) , vy2 (nlq) , vy3 (nlq) , vy4 (nlq) , 

4  vy5 (nlq) , vy6 (nlq) , vy7 (nlq) ,  vy8 (nlq) , 

5  vzl (nlq) , vz2 (nlq) , vz3 (nlq) , vz4 (nlq) , 

6  vz5 (nlq) , vz6 (nlq) , vz7 (nlq) , vz8 (nlq) 
common/auxlO/area (nlq) , 

1  pxl (nlq) , px2 (nlq) , px3 (nlq) , px4 (nlq) , 

&  px5 (nlq) , px6 (nlq) , px7 (nlq) , px8 (nlq) , 

2  pyl (nlq) ,py2 (nlq) ,py3 (nlq) ,py4 (nlq) , 

&  py5 (nlq) ,py6 (nlq) ,py7 (nlq) ,py8 (nlq) , 

3  pzl (nlq)  , pz2 (nlq) ,pz3 (nlq) ,pz4 (nlq) , 

&  pz5 (nlq) ,pz6 (nlq) ,pz7 (nlq) ,pz8 (nlq) , 

4  dxl (nlq) , dx2 (nlq) , dx3 (nlq) , dx4 (nlq) , 

5  dx5 (nlq)  ,  dx6 (nlq) , dx7 (nlq) , dx8 (nlq) , 

6  dyl (nlq) , dy2 (nlq) , dy3 (nlq) , dy4 (nlq) , 

7  dy5 (nlq) , dy6 (nlq) , dy7 (nlq)  ,  dy8 (nlq)  , 

8  dzl  (nlq) ,  dz2  (nlq) ,  dz3  (nlq) dz4  (nlq)  , 

9  dz5 (nlq)  ,  dz6 (nlq)  ,  dz7 (nlq) , dz8 (nlq) 
common/auxl3/ 

&zeta (nlq) ,  thick (nlq) , fga (nlq) ,  fgb (nlq) , fgc (nlq) , 

&glll (nlq) ,  gll2 (nlq) ,  gll3 (nlq) , gl21 (nlq) , gl22 (nlq) , gl23 (nlq) , 

&gl31 (nlq) , gl32 (nlq) , gl33 (nlq) , 

&xl (nlq) , yl (nlq) , zl (nlq) , x2 (nlq) ,  y2 (nlq) , z2 (nlq) , 

&x3 (nlq) , y3 (nlq) , z3 (nlq) , x4 (nlq) , y4 (nlq) , z4 (nlq) 
common/auxl4/ 

1  sigl (nlq) , sig2 (nlq) , sig3 (nlq) ,  sig4 (nlq) , 

2  sig5 (nlq) , sig6 (nlq) ,  ep (nlq) , epxl (nlq) , 

3  epx2 (nlq) , epx4 (nlq) , epx5 (nlq) , epx6 (nlq) , aux (nlq, 59) 
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common/auxl2/ 

1  wxxl (nlq) ,wxx2 (nlq) ,wxx3 (nlq) ,  wxx4 (nlq)  , 

2  wyyl (nlq) , wyy2 (nlq) ,wyy3 (nlq) , wyy4 (nlq)  , 

3  wzzl (nlq) , wzz2 (nlq) , wzz3 (nlq)  ,wzz4 (nlq)  , 

4  al3 (nlq) , a23 (nlq) , a33 (nlq) 
common/aux33/ 

1  ixl (nlq) , ix2 (nlq) , ix3 (nlq) , ix4 (nlq) , ixs (nlq, 4 ) ,mxt (nlq) 
common/aux35/rhoa (nlq) , cxx (nlq) , f cl (nlq) , f cq (nlq) 
common/aux36/lft, lit 

common/sound/sndspd,  sndsp (nlq) , diagm (nlq) , sarea (nlq) , dxl (nlq) 
common/bktb/ntbsl, nods, nodm, ips, ipm, ipa, ipb, ipc, ipd, 

1  ipe, ipf , ipg, iph, ipi, ipj , ipk 

coiranon/ssbsis/h (8, 5,5),pr(8,5,5),ps(8,5,5),pt(8,5,5), ipt, 

1  nip,  wgts  (5,  5) ,  zet  (5,  5) 
common/shlopt/istrn, istupd, ibelyt 
common /hour g/ymod, gmod, ifsv 
common/sandl/ihf , ibemf , ishlf , itshf 
common/failul/sieu (nlq) ,  fail (nlq) 
common/energy/xinen 

common/ kinet/enkint (nlq) ,xmomnt (nlq) ,ymomnt (nlq) , zmomnt (nlq) 

dimension  ixp(5, *) ,x (3, *) , rhs (* ) , vt (3, * ) , vr (3, *) ,yhatn(12, *) , 

1  auxvec (*) ,mtype (*) , ro (*) , cm(*) , csprop (24,  *)  ,  rule (mpusr,  3,  *)  , 

2  f ibl ( 9 , * ) , nsubgv ( * ) , mtnum ( * ) , nf egp ( * ) , ihgq ( * ) ,  hgq ( * ) , 

3  strain (12, *) ,isrn(2, 6) , ener (*) ,iblks (*) ,xies (*) ,  emain(6,nlq) , 

4  shapef (4 ) , aj (3,3), ajinv (3, 3) , tl (3, 3) , tlinv (3, 3) , edispg (24 ) , 

5  edisp (24 ) , shapel (3) , derivg (3, 4) , vl (3) , v2 (3) , v3 (3) , rot6t (6,6), 

6  deriva(4) ,derivb(4) ,derilg(3, 4) ,estrain(6) ,estrainp{6) , 

7  bmtx (6, 24, nlq) , rotall (6, 6, nlq) ,ajdet (nlq) , tlall (3, 3, nlq)  , 

8  estress (6) , estressg (6) , eforce (24 ) , eforceg (24 ) , sforcel (nlq, 4) , 

9  sforce2 (nlq, 4) , sforce3 (nlq, 4) , sforce4 (nlq, 4) , sforce5 (nlq, 4) , 

1  s force 6 (nlq, 4 )  ,  rotrn (6,6) , bmtxt (24,6), str33 (nlq) , ndlist (nlq* 4) 

data  isrn/1, 1, 1, 2, 2, 3, 1, 4, 2, 5, 0, 0/ 
data  deriva/-0 . 25, 0 . 25, 0 . 25, -0 . 25/ 
data  derivb/-0 . 25, -0 . 25, 0 . 25, 0 . 25/ 

rho=l . /ro (mxe) 
nip=nint ( csprop ( 2 , mxe ) ) 
irl=nint (csprop (4, mxe) ) 
nrl=iabs (irl) 

if  (nip.gt.5.and.irl.eq.O)  irl=l 
zbr=csprop ( 1 3 , mxe ) 
ifsv=ihgq(mxe) 
ipt=l 

rhoa ( If t ) =ro (mxe ) 
qhg=. 25*hgq (mxe) 
mte=mtype (mxe) 
if  (mte.eq.20)  return 
nmtcon=7+nconst (mte) 
sndspd=l . e-20 
ym=cm ( 48* (mxt (lft ) -1) +1) 
do  10  i=lft, lit 
thick ( i ) =f ibl ( 1 , nnml+i ) 
str33 (i) =0 . 0 
do  10  j =1,4 
sforcel(i,j)  =  0.0 
sforce2(i,j)  =  0.0 
sforce3(i,j)  =  0.0 
sforce4(i,j)  =0.0 
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sforce5(i,j)  =  0.0 
sfor ce6 (i, j )  =  0 . 0 
10  continue 

c  ***  Support  for  Drilling  Moment  addition  to  reflect  pressure 
c  applied  to  surface,  which  requires  a  list  of  nodes  for  this 

c  group  of  elements.  This  list  might  be  more  efficiently  generated 

c  outside  the  time  loop  (in  the  initialize  phase),  but  that  would 

c  require  a  lot  of  changes  in  initlz  et  al.,  plus  the  addition  of 

c  and  additional  global  array.  Using  this  list  allows  the  drilling 

c  moment  calculations  to  be  made 

c  for  only  those  nodes  that  are  attached  to  KM  shell  elements, 

which 

c  can  result  in  significant  speed  gains  on  large  systems  with 

multiple 

c  multiple  element  types. 

c  Create  node  list 

do  15  i=lft, lit 
jn= ( i— 1 ) *4 
ndlist ( jn+1) =ixl (i) 
ndlist (jn+2 ) =ix2 (i) 
ndlist (jn+3) =ix3 (i) 
ndlist (jn+4 ) =ix4 (i) 

15  continue 

c  Remove  duplicates  (no  need  to  sort) 
nlstm= (llt-lft+1) *4 
i=l 

do  while  (i.lt.nlstm) 

j=i+l 

do  while  (j.le.nlstm) 
if  (ndlist (i) . eq. ndlist (j ) )  then 
do  16  k=j,nlstm-l 

16  ndlist (k) =ndlist (k+1) 
ndlist  (nl.stm)  =0 
nlstm=nlstm-l 

endif 

'  j-j+1 

enddo 

i-i+1 

enddo 

if  (ishlf.ne.l)  then 

c  Retrieve  Nodal  Coordinates  and  velocities  for  no-failure 
do  20  i=lft, lit 
sieu (i) =xies (nnml+i) 
xl(i)  =x (1, ixl (i) ) 
yl(i)  =x (2, ixl (i)  ) 
zl(i)  =x(3,ixl(i)) 
x2  (i)  =x  (1,  ix2  (i)  ) 
y2  (i)  =x  (2,  ix2  (i)  ) 
z2  (i)  =x  (3,  ix2  (i)  ) 
x3(i)  =x (1, ix3 (i) ) 
y3 (i)  =x (2, ix3 (i) ) 
z3(i)  =x(3,ix3(i)) 
x4  (i)  =x  (1,  ix4  (i)  ) 
y4(i)  =x (2, ix4 (i) ) 
z4  (i)  =x  (3,  ix4  (i)  ) 
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dxl ( i ) =vt ( 1 , ixl ( i ) ) 
dyl (i) =vt (2, ixl (i) ) 
dzl (i) =vt (3, ixl  (i) ) 
dx2 ( i ) =vt ( 1 , ix2 ( i ) ) 
dy2 { i ) =vt ( 2 , ix2 ( i ) ) 
dz2 ( i ) =vt ( 3 , ix2 ( i } ) 
dx3 ( i ) =vt ( 1 , ix3 ( i ) ) 
dy3 ( i ) =vt ( 2 , ix3 ( i ) ) 
dz3  (i)  =vt  (3,  ix3  (i)  ) 
dx4 ( i ) =vt ( 1 , ix4 ( i ) ) 
dy4  (i)  =vt  (2,  ix4  (i)  ) 
dz4 (i)=vt (3, ix4  (i) ) 
wxxl (i)=vr (1, ixl (i) ) 
wyy 1 ( i ) =vr ( 2 , ixl ( i ) } 
wzzl (i) =vr (3, ixl (i) ) 
wxx2 ( i ) =vr { 1 , ix2  ( i ) ) 
wyy2 ( i ) =vr ( 2 , ix2 ( i ) ) 
wzz2 (i) =vr (3, ix2  (i) ) 
wxx3 ( i ) =vr ( 1 , ix3  ( i ) ) 

.  wyy3 (i)=vr (2, ix3  (i) ) 
wzz3 (i) =vr (3, ix3 (i)  ) 
wxx4 ( i ) =vr ( 1 , ix4 ( i ) ) 
wyy4 ( i ) =vr ( 2 , ix4  ( i ) ) 
wzz4 (i) =vr (3, ix4 (i) ) 

20  continue 

else 

c  Retrieve  Nodal  Coordinates  and  Velocities  w/failure 
do  30  i=lft,llt 
sieu (i) =xies (nnml+i) 
xl (i)  =x (1, ixl (i) ) 
yl(i)  =x (2, ixl (i) ) 
zl (i)  =x (3, ixl (i) ) 
x2  (i)  =x  (1,  ix2  (i)  ) 
y2(i)  =x  (2, ix2 (i) ) 
z2  (i)  =x  (3,  ix2  (i)  ) 
x3  (i)  =x  (1,  ix3  (i)  ) 
y3(i)  =x (2, ix3 (i) } 
z3  (i)  =x  (3,  ix3  (i)  ) 
x4 (i)  =x(l,ix4 (i) ) 
y4(i)  =x (2, ix4 (i) ) 
z4 (i)  =k (3, ix4  (i) ) 
dxl  (i)  =vt  (1,  ixl  (i)  )  *fail  (i) 
dyl  (i)  =vt  (2,  ixl  (i)  )  *fail  (i) 
dzl (i) =vt (3, ixl (i) ) *fail  (i) 
dx2 ( i ) =vt ( 1 ,  ix2 ( i ) ) *  f ail ( i ) 
dy2 ( i ) =vt ( 2 , ix2 { i ) ) *  fail ( i ) 
dz2  (i)  =vt  (3,  ix2  (i)  )  *fail  (i) 
dx3 (i) =vt (1, ix3 (i) ) *fail  (i) 
dy3 (i) =vt (2, ix3 (i) ) *fail  (i) 
dz3 ( i ) =vt (3,  ix3 (i) ) *fail (i) 
dx4 (i) =vt (1, ix4 (i) ) *fail  (i) 
dy4 ( i ) =vt (2, ix4 (i) ) *fail (i) 
dz4 (i)=vt (3, ix4 (i) ) *fail (i) 
wxxl  (i)  =vr  (1,  ixl  (i)  )  *fail  (i) 
wyyl  (i)  =vr  (2,  ixl  (i)  )  *fail  (i) 
wzzl (i)=vr (3, ixl (i) ) *fail (i) 
wxx2 (i) =vr (1, ix2 (i) ) *fail (i) 
wyy2 (i) =vr (2, ix2 (i) ) *fail (i) 


wzz2 (i) =vr (3, ix2 (i) ) *fail (i) 
wxx3 (i) =vr (1, ix3 (i) ) *fail (i) 
wyy3 (i) =vr (2, ix3 (i) ) *fail (i) 
wzz3 (i) =vr (3, ix3 (i) ) *fail  (i) 
wxx4 (i) =vr (1, ix4 (i))*fail(i) 
wyy4 (i) =vr (2, ix4 (i) ) *fail  (i) 
wzz4 (i) =vr (3, ix4 (i) ) *fail (i) 

30  continue 
endif 

c  Calculate  Momentums  and  Kinetic  Energy 
rho8th  =  0 . 125*rhoa (1ft) 
rho4th  =  0 . 25*rhoa (1ft) 
do  35  i=lft, lit 

dx=dxl (i) **2+dx2 (i) **2+dx3 (i) **2+dx4 (i) **2 
dy=dyl (i) **2+dy2 (i) **2+dy3 (i) **2+dy4 (i) **2 
dz=dzl (i) **2+dz2 (i) **2+dz3 (i) **2+dz4 (i) **2 
enkint (i)=fibl (l,nnml+i) *rho8th* (dx+dy+dz) 

xmomnt (i) =fibl (1, nnml+i) *rho4th* (dxl (i) +dx2 (i) +dx3 (i ) +dx4 (i) ) 
ymomnt (i) =fibl (1, nnml+i) *rho4th* (dyl (i) +dy2 (i ) +dy3 (i) +dy4 (i) ) 
zmomnt (i) =fibl (1, nnml+i) *rho4th* (dzl (i) +dz2 (i) +dz3 (i) +dz4 (i) ) 
35  continue 

c  Calculate  laminae  vectors  and  surface  area 
call  dfnls (fibl (l,nnml+l) ,nip) 
call  kmtran 

c  ***  Loop  through  elements,  get  transormed  displacement  *** 

c  and  calculate  rotation  matrices 

do  70  ie=lft, lit 

c  Rename  unit  vectors  locally  to  facilitate  strain  calculation 

c  Node  1  to  2 

vl(l)  =  gill (ie) 
vl (2 )  =  gl21 (ie) 
vl (3)  =  gl31 (ie) 

c  Node  1  to  4  (Actually  Vl  x  V3) 

v2 ( 1 )  =  gll2 (ie) 

v2 (2)  =  gl22 (ie)  , 

v2 (3)  =  gl32 (ie) 

c  Normal  to  reference  plane 

v3 (1)  =  gll3 (ie) 
v3 (2)  =  gl23 (ie) 
v3 (3 )  =  gl33 (ie) 

c  Rotation  tranformation  matrix,  and  its  inverse 
do  40  i=l, 3 
tl (i, 1)  -  vl ( i ) 
tl  (i,  2)  =  v2  (i) 
tl  (i,  3)  =  v3  (i) 

40  continue 

call  kminv3 (tl, tlinv, det) 

c  Store  for  use  in  force  transformation 
do  50  i=l, 3 
do  50  j=l, 3 

50  tlall (i,  j , ie) =tl  (i, j  ) 

c  Strain  Transformation  Matrix 
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rotall (1, 1, ie) =vl (1) **2 

rotall (1, 2, ie)=vl (2) **2 

rotall (1,3, ie)=vl (3) **2 

rotall (1,4, ie)=vl (1) *vl (2) 

rotall (1,5, ie)=vl (2) *vl (3) 

rotall  (1,  6,  ie)  =vl  (1)  *vl  (3) 

rotall (2,1, ie) =v2 (1) **2 

rotall (2,2, ie) =v2 (2) **2 

rotall (2,3, ie) =v2 (3) **2 

rotall (2, 4, ie) =v2 (1) *v2  (2) 

rotall  (2,  5,  ie)  =v2  (2) *v2 (3) 

rotall (2, 6, ie)=v2 (1) *v2 (3) 

rotall (3,1, ie)=v3 (1) **2 

rotall (3,2, ie) =v3 (2 ) **2 

rotall (3, 3, ie) =v3 (3) **2 

rotall (3, 4, ie) =v3 (1) *v3 (2) 

rotall (3,5, ie) =v3 (2 ) *v3 (3) 

rotall  (3,  6,  ie)  =v3  (1)  *v3  (3) 

rotall  (4, 1,  ie)  =2 . 0*vl  (1)  *v2  (1) 

rotall (4,2, ie) =2. 0*vl (2) *v2 (2) 

rotall (4,3,ie)=2.0*vl (3) *v2 (3) 

rotall (4,4, ie)=vl (1) *v2 (2) +v2 (1) *vl (2) 

rotall (4,5, ie) =vl (2) *v2 (3) +v2 (2 ) *vl (3) 

rotall (4, 6, ie) =vl (3) *v2 (1) +v2 (3) *vl (1) 

rotall (5,1, ie)=2.0*v2 (1) *v3 (1) 

rotall (5,2,ie)=2.0*v2(2) *v3 (2) 

rotall (5,  3, ie) =2 . 0*v2 (3) *v3 (3) 

rotall (5,4, ie) =v2 (I)*v3(2)+v3(l) *v2 (2) 

rotall (5, 5, ie)=v2 (2) *v3 (3) +v3 (2) *v2 (3) 

rotall  (5,  6,  ie)  =v2  (3)  *v3  (1)  +v3  (3)  *v2 (1) 

rotall ( 6 , 1 , ie ) =2 . 0*v3 ( 1 ) *vl ( 1 ) 

rotall (6, 2, ie)=2 . 0*v3 (2) *vl (2) 

rotall (6, 3, ie)=2. 0*v3 (3) *vl (3) 

rotall (6, 4, ie)=v3 (1) *vl (2) +vl (1) *v3 (2) 

rotall  (6,  5,  ie)  =v3  (2)  *vl  (3)  +vl  (2)  *v3  (3) 

rotall (6, 6, ie)=v3 (3) *vl (1) +vl (3) *v3 (1) 

c  Rename  displacement  for  code  compatability  (Global  Coord) 
call  kmcpdp (edispg, 1, ie) 

c  Transform  rotations  into  local  coordinates 
do  60  i=l,4 
do  60  j=l,3 

edisp  (  { i— 1 ) *6+ j ) =edispg ( { i— 1 ) *6+j  ) 

edisp ( (i-1) *  6+3+ j )  =  (edispg ( ( i— 1 ) *6+4) *tlinv ( j , 1) 

1  edispg ( (i-1) *6+5) *tlinv(j  ,  2)  + 

2  edispg ( (i-1 ) *6+6) *tlinv (j , 3) ) 

60  continue 

c  Put  back  displacements 

call  kmcpdp (edisp, 0, ie) 

c  ***  End  Element  Setup  *** 

70  continue 

c  ***  Begin  Integration  Loop  *** 
do  230  iz=l,nip 
ipt  =  iz 

c  Get  Gauss  Point 
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if (irl . eq. 0) then 
zta  =  zet (iz, nip) 
elseif  (irl.gt.O)  then 
zta  =  2.0  *  (iz-1) / (nip-1) -1 . 0 
else 

zta  =  rule (iz, 1, nrl) 
mtu  =  nint (rule (iz, 3, nrl) ) 
mtv=mxt (lft) 
if  (mtu.ne.O)  then 
mxt (lft) =mtu 
endif 
endif 

call  kmshap (zta,  shapel ) 

c  ***  Begin  Element  Strain  Calculation  *** 
do  130  ie=lft, lit 

c  Jacobian,  inverse  and  its  determinant  (stored) 

hz=thick (ie) *0.5* (shapel (2) * ( 1 . 0-zbr ) -shapel ( 1) * ( 1 . 0+zbr) ) 
hzdt=thick (ie) *0 . 5 

aj  (1, 1)  =0 . 25*  (-xl  (ie)  +x2  (ie)  +x3  (ie)  -x4  (ie)  ) 
aj  (2, 1)  =0 . 25*  (-xl  (ie)  -x2  (ie)  +x3  (ie)  +x4  (ie)  ) 
aj (3, 1) =hzdt*gll3 (ie) 

aj  (1, 2)  =0 . 25*  (-yl  (ie)  +y2  (ie)  +y3  (ie)  -y4  (ie)  ) 
aj  (2, 2)  =0 .25*  (-yl  (ie)  -y2  (ie)  +y3  (ie)  +y4  (ie)  ) 
aj (3, 2) =hzdt*gl23 (ie) 

aj  (1, 3)  =0 . 25*  (-zl  (ie) +z2  (ie) +z3  (ie) -z4  (ie)  ) 
aj (2,  3) =0 . 25* (-zl (ie) -z2 (ie) +z3 (ie) +z4  (ie) ) 
aj (3, 3) =hzdt*gl33 (ie) 

call  kminv3 (aj , ajinv, det) 
ajdet(ie)  =  det 

c  compute  global  derivatives  and  strain-nodal  displacement  matrix 
do  80  in=l, 4 

derivg (1, in) =aj inv (1,1) *deriva (in) +ajinv (1,2) *derivb (in) 
derivg (2, in) =aj inv (2, 1) *deriva (in) tajinv (2,2) *derivb (in) 
derivg (3, in) =aj inv (3, 1) *deriva (in) +a jinv (3,2) *derivb (in) 
derilg (1, in) =aj inv (1, 3) *hzdt 
derilg (2,  in) =aj inv (2, 3) *hzdt 
derilg (3, in) =aj inv (3, 3) *hzdt 
80  continue 

c  Zero  out  B  matrix 
do  90  i=l,6 
do  90  j=l, 24 
90  bmtx (i, j , ie) =0 . 0 

c  Calculate  B  Matrix 
do  100  in=l, 4 
il=(in-l) *6+1 
i2=il+l 
i3=i2+l 
i4=i3+l 
i5=i4+l 
i6=i5+l 

gkl=derivg ( 1, in) *hz+0 . 25*derilg (1, in) 
gk2=derivg (2, in) *hz+0 . 25*derilg (2, in) 
gk3=derivg (3, in) *hz+0 . 25*derilg (3, in) 
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c 

bmtx (1, il, ie) =derivg (1, in) 
bmtx (1, i4, ie)=gkl* (-gll2 (ie) ) 
bmtx (1, i5, ie) =gkl*glll (ie) 
bmtx (1, i6, ie) =gkl*gll3 (ie) 
bmtx (2, i2, ie) =derivg (2, in) 
bmtx (2, i4, ie) =gk2* (-gl22 (ie) ) 
bmtx (2, i5, ie) =gk2*gl21 (ie) 
bmtx (2, i6, ie)=gk2*gl23 (ie) 
bmtx (3, i3, ie) =derivg (3,  in) 
bmtx (3, i4 , ie) =gk3* (-gl32 (ie) ) 
bmtx (3, i5, ie) =gk3*gl31 (ie) 
bmtx (3, i6, ie)=gk3*gl33 (ie) 
bmtx (4, il, ie) =derivg (2,  in) 
bmtx (4, i2, ie) =derivg (1, in) 

bmtx (4, i4, ie) =gk2* (-gll2 (ie) ) +gkl* (-gl22 (ie) ) 
bmtx (4, i5, ie) =gk2*glll (ie) +gkl*gl21 (ie) 
bmtx (4, i6,ie)=gk2*gll3 (ie) +gkl*gl23 (ie) 
bmtx (5, i2, ie) =derivg (3, in) 
bmtx (5, i3, ie) =derivg (2,  in) 

bmtx (5, i4, ie) =gk3* (-g!22 (ie) ) +gk2* (-gl32 (ie) ) 
bmtx (5, i5, ie) =gk3*gl21 (ie) +gk2*gl31 (ie) 
bmtx (5, i6, ie) =gk3*gl23 (ie) +gk2*gl33 (ie) 
bmtx (6, il, ie) =derivg (3,  in) 
bmtx (6, i3, ie) =derivg (1, in) 

bmtx ( 6, i4 , ie) =gk3* (-gll2 (ie) )+gkl* (-gl32 (ie) ) 
bmtx (6, i5, ie) =gk3*glll (ie) +gkl*gl31 (ie) 
bmtx (6, i6, ie) =gk3*gll3 (ie) +gkl*gl33 (ie) 

100  continue 

c  Retrieve  rotated  displacements 
call  kmcpdp (edisp, 1, ie) 

c  Calculate  Strain 

do  110  i=l, 6 
estrainp (i) =0 . 0 
do  110  k=l, 24 

110  estrainp (i) =estrainp (i) +bmtx (i, k, ie) *edisp (k) 

c  Transform  strain  to  local  coordinates  system 
do  120  i=l, 6 
estrain (i) =0 . 0 
do  120  k=l,  6 

120  estrain (i) =estrain (i) trotall (i,  k,  ie) *estrainp (k) 

c  Store  Strain  increments 

d.l(ie)  =  estrain  (1)  *dtl 
d2(ie)  =  estrain (2) *dtl 
d3(ie)  =  estrain (3) *dtl 
d4 (ie)  =  estrain (4 ) *dtl 
d5(ie)  =  estrain (5) *dtl 
d6(ie)  =  estrain ( 6) *dtl 
zeta (ie) =zta*thick (ie) 
einc(ie)  =  0.0 

c  ***  End  of  element  strain  loop  *** 

130  continue 

c  Constitutive  Model  Evaluation  (ie  strain  to  stress) 
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call  kmcon  (nmtcon, auxvec, cm, lav,mte, nip, ipt, csprop (l,mxe) , 

1  dampk, ym,prv,mxe) 

c  if  strain  output  is  selected,  store  strain  tensor  for  this  ipt 
if  (istrn.ne.O)  then 
if  (irl.eq.O)  then 
if  (iz . eq. isrn (1, nip) )  then 

call  tbstbo  (strain (1, nnml+1) ,  cm,  nnml,  mte,  emain  (1, 1) ') 
endif 

if  (iz . eq. isrn (2, nip) )  then 

call  tbstbo  ( strain (7, nnml+1 ) ,  cm,  nnml,  mte,  emain (4,1)) 
endif 
else 

if  (iz.eq.l  )  then 

call  tbstbo  (strain (1, nnml+1) ,  cm,  nnml,  mte,  emain (1,1)) 
endif 

if  (iz.eq.nip)  then 

call  tbstbo  (strain (7, nnml+1) ,  cm,  nnml,  mte,  emain(4,l)) 
endif 
endif 
endif 

c  Get  gauss  weight 

if  (irl.eq.O)  then 
fac=wgts (iz, nip) 
elseif  (irl.gt.O)  then 
fac=2 , / (nip-1) 
else 

fac=rule (iz, 2, nrl) 
mxt(lft)=mtv 
endif 

c  ***  Begin  Element  Force  Loop  *** 
do  200  ie=ift, lit 

c  Update  epsilon  zz,  if  selected 

if  (istupd.ne. 0)  str33 (ie) =str33 (ie) +0 . 5*fac*d3 (ie) 

c  Copy  Element  stress  tensor  to  local  variable 
estress (1) =sigl (ie) 
estress (2) =sig2 (ie) 
estress (3) =sig3 (ie) 
estress (4 ) =sig4 (ie) 
estress (5) =sig5 (ie) 
estress (6) =sig6 (ie) 

c  Get  transpose  of  rotation  matrix 
do  140  i=l,6 
do  140  j =1,6 

140  rotrn (i, j ) =rotall ( j , i, ie) 

c  Rotate  stresses  to  global  coordinates 
do  150  i=l, 6 
estressg(i)=0. 0 
do  150  k=l, 6 

150  estressg (i) =estressg (i) +rotrn (i, k) *estress (k) 

c  Get  transpose  of  B  matrix 
do  160  1=1,24 
do  160  j  =1 , 6 
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160  bmtxt (i, j ) =bmtx ( j  ,  i,  ie) 

c  Calculate  element  forces 
do  170  i=l, 24 
eforce (i) =0 . 0 
do  170  k=l, 6 

170  eforce (i) =eforce (i) +bmtxt (i,  k) *estressg(k) 

c  Rotate  moments 

do  180  i=l, 4 

do  180  j=l, 3  * 

eforceg ( ( i— 1 ) *6+ j ) =eforce ( { i— 1 ) *6+j ) 
eforceg ( ( i— 1 ) *  6+3+ j ) =e force ( (i-l)*6+4)*tlall(j,l,ie) 

1  +  eforce ( (i-1) *6+5) *tlall (j , 2, ie) 

2  +  eforce ( (i-1) *6+6) *tlall (j , 3, ie) 

180  continue 

c  Sum  up  forces  for  each  node 

detwt=ajdet (ie) *4 . 0*fac 

c  4.0  comes  from  x  and  y  gauss  weights  (2.0  each) 

do  190  i-1, 4 

sforcel  (ie,  i)  =  sforcel  (ie,  i)  +  eforceg  (.(i-1)  *6+1)  *detwt 
sforce2  (ie, i)  =  sforce2 (ie, i)  +  eforceg ( (i-1) *6+2) *detwt 
sforce3 (ie, i)  =  sforce3 (ie, i)  +  eforceg ( (i-1) *6+3) *detwt 
sforce4 (ie, i)  =  sforce4 (ie, i)  +  eforcegf (i-1) *6+4) *detwt 
sforce5 (ie, i)  =  sforce5 (ie, i)  +  eforceg ( (i-1) *6+5) *detwt 
sforce6  (ie,  i)  =  sforce6  (ie,  i)  +  eforceg  (  (i-1)  *'6+6)  *detwt 
190  continue 

c  ***  End  of  Element  Force  Loop  *** 

200  continue 

c  Do  for  compatability  with  output  routines;  b(ipi)  =  volf,  b(iph)  =  epf 
faci=l./fac 
do  220  i=lft, lit 
fga (i) =fac*fga (i) 
fgb (i) =fac*fgb (i) 
if  (ipi.eg.iph)  go  to  210 
b ( ipi+i+nnml ) =b ( ipi+i+nnml ) +f ga ( i ) 
b (iph+i+nnml) =b (iph+i+nnml) +ep (i) *fga (i) 

210  xies(i)  =xies (i) + . 5*fga (i) *sarea (i) *einc (i) 
fga(i)  =faci*fga(i) 
fgb(i)  =faci*fgb(i) 

220  continue 

***  End  of  Integration  Loop 
230  continue 

c  Change  shell  thickness  if  required 

c  ***  Must  be  an  error  in  indexing  -  causes  "Access  Violation" 
if  (istupd.ne. 0)  then 
do  240  ie=lft, lit  , 
indfib  =  nnml+1+ie 
str33 (ie) =1 . +str33 (ie) 

fibl (1, indfib) =str33 (i) *fibl (1, indfib) 

b (istupd+ixl (ie) ) =  max (b (istupd+ixl (ie) ),  fibl (1, indfib) ) 
b (istupd+ix2 (ie) ) =  max (b (istupd+ix2 (ie) ) , fibl (1, indfib) ) 
b (istupd+ix3 (ie) )=  max (b (istupd+ix3 (ie) ) , fibl (1, indfib) ) 
b (istupd+ix4 (ie) )=  max (b (istupd+ix4 (ie) ) , fibl (1, indfib) ) 

240  continue 
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endif 

c  Compute  hourglass  forces  and  add  to  internal  forces,  then 
c  store  in  appropriate  global  variables 

sndspd=sqrt (sndspd*rho) 

call  kmfrc (rhs, rhs (1+neq) , fibl {2, nnml+1) ,mte, iblks, sforcel, 

1  sforce2, sforce3,  sforce4 ,  sforce5,  sforce6,  ndlist,  nlstm, 

2  ym, rotall, b (lcll) ,b (lcl3) ) 

return 

end 


110 


o  n  a 


subroutine  sca_get  (mtype, csprop, x, ieost, ixp, auxvecl, 

1  stress, Ins, nshpnt, lochvs, nel, nmel, ival, val, ipt ) 

0  **************************************************************** 

c  Retrieve  scalar  value  in  AUX14  for  each  integration  point 
c  (for  shells) 

c 

c  called  by  additional  contour  plots:  sca_asc, sca_ten, sca_dys, 
c 

c  call  sca_get  (a (nl) , a (n4f ) , a (lcll) , a (n4a) , a (lcls) ,  a (ns06) , 

c  f  sig,  Ins,  a (nsl3) , a (nsl4 ) , nel, nmel, ival, val, ipt ) 

MCDERMOTT  /  1999 

********************************************************************* 
implicit  double  precision  (a-h,o-z) 
include  'nlqpar.inc' 

common/bkl9/nconst ( 60) , lenma, ncneos (15) 
dimension  mtype (*), csprop (24, *) ,x (*),  ieost (*) , 

2  ixp (5, * ) , auxvecl (*) , stress  (4  9, nlq) , ix (20) , nshpnt (* ) , lochvs (* ) , 

3  val (nlq) 

call  azero (val, nlq) 
do  10  k=l,nmel 

c  Get  Relevant  Pointers  and  offsets 

nel  «=  nel+1 
nnel  =  nshpnt (nel) 
lav  =  lochvs (nnel) 
call  unpk (mx, ix, ixp (1, nnel) , 2) 
mte  =  mtype (mx) 
nes  =  ieost (mx) 

nmtcon  =  7+nconst (mte) tncneos (maxO (nes,  1) ) 
c  Extract  value  for  desired  integration  point 

ind  =  (ipt-1) *nmtcon 

call  blkcpy (auxvecl (lav+ind) , stress (1, k) , nmtcon) 
val (k) =stress (ival, k) 

10  continue 
return 
end 


subroutine  sets44(cm) 
implicit  double  precision  (a-h,o-z) 
dp 

q  •kie-k-k-k’k-kie-k-k'k'k-k-ie-k-k-k-k'k-k-k'k'k-k'kif’k-k'k'k'k’k'k'k'k-k-ie-k'if'kie'ieieir’k’k'k'k'k'ir'k-k'k'fe’k'fe'k-k'fe 

c  called  by  matin  to  set  parameters  for  material  type  44 

c 

c  call  sets44  (cm(l,n)) 

c  McDermott  1999 

Q  ********************************************************** 

dimension  cm (48 ), strain (16) , stress (16) , slope (16) 

c  Number  of  segments  in  stress-strain  curve 

.  iseg=int (cm(ll) )  . 

estrain  =  cm (4)  /  cm(l) 

c  Copy  endpoints  to  temp  array 

do  10  i=l, 16 
strain (i) =cm(i+ll) 
stress (i)=cm(i+27) 

10  continue 

c  Calculate  slopes 

if  (iseg.ge.l)  then 

slope(l)  =  (stress (1) -cm ( 4 ))/ (strain ( 1) -estrain) 
if  (iseg.ge.2)  then 
do  20  i=2,iseg 

20  slope(i)  =  (stress (i) -stress ( i— 1 ) )/ (strain (i) -strain ( i— 1 ) ) 
endif 
endif 

c  Redo  cm  array  (zero  unused  values) 

do  30  i=l,16 
if  (iseg.ge.i)  then 
cm(2* (i-1) +12)  =  slope(i) 
cm(2* ( i— 1 ) +13)  =  strain(i) 
else 

cm (2* (i-1) +12)  =  0.0 
cm (2* (i-1) +13)  =0.0 
endif 

30  continue 
return 
end 
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subroutine  shl44s  (cm,capa) 
implicit  double  precision  (a-h,o-z) 
include  'nlqpar.inc' 

c  Elastic-plastic  isotropic  material  with  void  growth  and  nucleation 

c  and  piecewise-linear  stress-strain  curve 

c  McDermott  1999 

common/bk02/iburn, isdo, dtl, dt2 

common/aux2/dl (nlq) , d2 (nlq) ,  d3 (nlq) , d4 (nlq) , d5 (nlq) , d6 (nlq) , 

1  wzzdt (nlq) , wyydt (nlq)  ,  wxxdt (nlq) ,  einc (nlq) 
common/auxl4/ 

1  sigl  (nlq)  ,  sig2  (nlq) ,  sig-3  (nlq) ,  sig4  (nlq) , 

2  sig5 (nlq) , sig6 (nlq) ,  ep (nlq) ,  epxl (nlq) , epx2 (nlq) , 

3  epx4 (nlq) , epx5 (nlq) ,  epx6 (nlq) , epx3 (nlq) , ef fs (nlq) , 

4  phi (nlq) , sigO (nlq) , aux (nlq, 55) 
common /auxl 8 /dd (nlq) ,  def (nlq) 
common/aux33/ 

1  ixl  (nlq)  ,  ix2  (nlq)  ,  ix3  (nlq) ,  ix4  (nlq) ,  ixs.  (nlq,  4 )  ,mxt  (nlq) 
common/aux35/rhoa (nlq) , cb (nlq) , davg (nlq) ,p (nlq) 
common/aux36/lft, lit 

common/sound/sndspd, sndsp (nlq)  ,  diagm  (nlq) , sarea (nlq) , dxl (nlq) 
common/hourg/ymod, gmod,  ifsv 

common/hourll/ebar (nlq) , ebarmn (nlq) , eyld (nlq) , etanmd (nlq) 
common/failul/sieu (nlq)  ,  f ailu (nlq) 

common/ssbsis/h (8, 5,5) , hpr (8, 5,5), hps (8,5,5), hpt (8,5,5), ipt, 

1  nip,  wgts  (5,  5) ,  zet  (5,  5) 
dimension  fail (nlq) , cm(*) , strain (20) , slope (20) 
data  third/-. 3333333333333333/ 
data  sfac/0. 8333333333333333/ 
data  eps/1.0e-4/ 

c 

c  Retrieve  Material  Properties  from  CM  array 
mx=48* (mxt (1ft) -1) 
ym=cm(mx+l) 
pr=cm (mx+2 ) 
phi0=cm(mx+3) 
syp=cm (mx+4 ) 
ql=cm(mx+5) 
q2=cm(mx+6) 
q3=cm(mx+7) 
fn=cm(mx+8) 

,.en=cm  (mx+9) 
sn=cm (mx+10) 
iseg=int (cm(mx+ll) ) 
ystrain=syp/ym 
strain ( 1 ) =ystrain 
if (iseg. gt . 0) then 
do  10  i=l,iseg 
slope (i)=cm(mx+10+i*2) 
strain (i+1) =cm(mx+ll+i*2) 

10  continue 
endif 
ymod=ym 

gmod=ym/ (2 . 0* (1 . 0+pr) ) 
bulk=ym/(3.0* (1.0-2. 0*pr) ) 
sndspd=ym/ (1 . 0-pr**2) 

c  Set  up  Element  Values 
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do  60  i=lft, lit 

einc  (i)  =dl  (i)  *sigl  (i)  +d2  (i)  *sig2  (i)  +d4  (i)  *sig4  (i)  +d5  (i)  *sig5  (i) 
+d6 (i) *sig6 (i) +d3 (i) *sig3 (i) 
plastrn  =  ep (i) 
phit  =  phi (i) 
stressO  =  sigO (i) 

sgl=sigl (i) +sndspd* (dl (i) +pr*d2 (i) ) 
sg2=sig2 (i) +sndspd* (pr*dl (i) +d2 (i) ) 
sg3=sig3 (i) +ym*d3 (i) 
sg4=sig4 (i) +gmod*d4 (i) 
sg5=sig5 (i) +sfac*gmod*d5 (i) 
sg6=sig6 (i) +sfac*gmod*d6 (i) 
press=third* (sgl+sg2+sg3) 
sl=sgl+press 
s2=sg2+press 
s3=sg3+press 

q=sqrt (1.5* (sl**2+s2**2+s3**2+2 . 0*sg4**2+ 

1  2.0*sg5**2+2.0*sg6**2) ) 

F= (q/stressO) **2+2 . 0*ql*phit* 

1  cosh (-1 . 5*q2*press/stress0) - (1 . 0+q3*phit**2 ) 

if  (F.gt.0.0)  then 
iter  =  0 
dep  =0.0 
deq  =0.0 

c  Begin  Iteration  Loop 

•20  cl=3.0*q2/ (2 . 0*stress0**2) 

Fql=2 . 0*q/ (stress0**2) 

Fq2=2 . 0/ (stress0**2) 

Fpl=-2 . 0*ql*phit*cl*sinh (-cl*press) 

Fp2=2 . 0*ql*phit*cl**2*cosh (-cl*press) 

Fsl=-q**2/ (2 . 0*stress0**3) +2 . 0*ql*phit*cl*press*sinh (-cl*press ) 
Fsp=2 . 0*ql*phit* (-cl**2*press*cosh (-cl*press) +cl/stress0* 

1  sinh (-cl*press) ) 

Fsq=-q/stress0**3 

c  Get  Partial  of  Yield  Stress  with  respect  to  dep 
stressl  =  syp 
esl  =  stressO/ym 

el  =  -press*dep/ ( ( 1-phit) *stress0) 
psl  =  plastrn  +  el  +  esl 
iflag  =0 
do  30  j=l,iseg 
if (iflag  .eq.  0)  then 
if (psl  .It.  strain (j+1) ) then 
stressl  =  stressl  +  slope (j )* (psl-strain (j ) ) 
isegl  =  j 
iflag  =1 
else 

stressl  =  stressl  +  slope (j )* (strain (j +1) -strain (j ) ) 
endif 
endif 

30  continue 

c  Numerical  Error  Trap 

if ( (stressl . eq. stressO)  .or.  (abs(el)  .eq.  0.0))  then 
dsdep  =  slope (isegl) 
else 

dsdep  =  (stressl-stressO) /el 
endif 

if  (abs (dsdep)  .gt.  ym)  dsdep  =  slope(isegl) 
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c  Get  Partial  of  Yield  Stress  with  respect  to  deq 
stressl  =  syp 

el  =  q*deq/ ( (1-phit) *stressO) 
psl  =  plastrn  +  el 
iflag  =  0 
do  40  j=l,iseg 
if (iflag  .eq.  0)  then 
if (psl  .It.  strain (j+1) ) then 
stressl  =  stressl  +  slope (j )* (psl-strain (j ) ) 
isegl  =  j 
iflag  =1 
else 

stressl  =  stressl  +  slope (j )* (strain (j+1 ) -strain (j ) ) 
endif 
endif 

40  continue 

c  Numerical  Error  Trap 

if ( (stressl . eq. stressO)  .or.  (abs(el)  .eq.  0.0))  then 
dsdeq  =  slope (isegl) 
else 

dsdeq  =  (stressl-stressO) /el 
endif 

if  (abs (dsdeq)  .gt.  ym)  dsdeq  =  slope (isegl) 

c  Apply  Newtons  Method 

a22  =  bulk*Fpl+Fsl*dsdep 
al2  =  3 . 0*gmod*Fql+Fsl*dsdeq 

a21  =  - (Fql+deq* (bulk*Fp2+Fsp*dsdep) +dep*Fsq*dsdep) 

all  =  Fpl+dep* (-3. 0*gmod*Fq2+Fsq*dsdeq) +deq*Fsp*dsdeq 

deta  =  all*a22-al2*a21 

all  =  all/deta 

al2  =  al2/deta 

a21  =  a21/deta 

a22  =  a22/deta 

bl  =  -1 . 0*F 

b2  =  -1 . 0*dep*Fql-deq*Fpl 
dep  =  dep  +  all*bl  +  al2*b2 
deq  =  deq  +  a21*bl  +  a22*b2 

c  Reset  Key  Parameters 
phit  =  phi(i) 
plastrn  =  ep(i) 
stressO  =  sigO (i) 

c  Plastic  Strain 

deplstl=dep/3. 0+1 . 5*deq*sl/q 
•  deplst2=dep/3 . 0+1 . 5*deq*s2/q 
deplst3=dep/3 . 0+deq*sg3/q 
deplst4=l . 5*deq*sg4/q 
deplst5=l . 5*deq*sg5/q 
deplst6=l . 5*deq*sg6/q 
degrowth  =  deplstl+deplst2+deplst3 

c  Adjust  stress,  q,  pressure,  etc. 

sgl  =  sigl(i)  +  sndspd* ( (dl (i) -deplstl) +pr* (d2 (i) -deplst2) ) 
sg2  =  sig2(i)  +  sndspd* (pr* (dl (i) -deplstl) + (d2 (i) -deplst2) ) 
sg3  =.sig3(i)  +  ym* (d3 (i) -deplst3) 
sg4  =  sig4(i)  +  gmod* (d4 (i) -deplst4 ) 
sg5  =  sig5(i)  +  sfac*gmod* (d5 (i) -deplst5) 
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sg6  =  sig6(i)  +  sfac*gmod*(d6(i)-deplst6) 
press  =  third* (sgl+sg2+sg3) 
si  =  sgl  +  press 
s2  =  sg2  +  press 
s3  =  sg3  +  press 

c  Calculate  Increase  in  Plastic  Strain  (must  be  >  0) 
deltep  =  (q*deq-press*dep) / ( (1-phit) *stress0) 
if(deltep  .It.  0.0)  deltep  =  0.0 
plastrn  =  plastrn  +  deltep 

c  Compute  Void  Nucleation  and  Growth 
if(fn  .ne.  0.0)  then 

anucl  =  fn/ (sn*2 . 506628274 63) *exp (-0 . 5* ( (plastrn-en) /sn) **2 
else 

anucl  =0.0 
endif 

phil  =  phit+ (1-phit) *degrowth+anucl*deltep 
c  Decrease  in  porosity  not  allowed 

if (phil . gt .phit)  phit  =  phil 

c  Turn  off  void  effects  if  ql  is  set  to  zero  (elastic-plastic  only) 
if(ql  .eq.  0.0)  phit  =  0.0 

c  Calculate  Strain  Hardening 
iflag  =  0 

psl  =  plastrn  +  stressO/ym 
stressO  =  syp 
do  50  j=l,iseg 
if (iflag. eq.0)  then 
if (psl . It .strain (j+1)  )  then 
estrain  =  -stressO/ym 

stressO  =  stressO  +  slope (j )* (psl-strain (j ) ) 
estrain  =  estrain  +  stressO/ym 
stressO  =  stressO+slope ( j ) *estrain 
iflag  =1 
else 

stressO  =  stressO  +  slope (j )* (strain(j+l) -strain(j ) ) 
psl  =  plastrn  +  stressO/ym 
endif 
endif 

50  continue 

c  Calculate  new  Yield  Function 

q=sqrt (1.5* (sl**2+s2**2+s3**2+2 . 0*sg4**2+ 

1  2.0*sg5**2+2.0*sg6**2) ) 

F= (q/stressO) **2+2 . 0*ql*phit* 

1  cosh (-1 . 5*q2*press/stress0) - (1 . 0+q3*phit**2 ) 

iter  =  iter+1 

c  Check  for  failure  to  converge 
if (iter . gt . 500)  then 

write (*,*)  ' SHL44S  -  Failed  to  Converge' 
call  adios (2) 
endif 

if (abs (F) .gt.eps)  goto  20 
else 

c  No  increase  in  plastic  strain,  set  tensor  to  zero 
deplstl=0.0 
deplst2=0 . 0 
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deplst3=0.0 

deplst4=0.0 

deplst5=0.0 

deplst6=0.0 

endif 

c  DONE!  Load  up  all  required  variables 
sigO (i)  =  stressO 
p(i)  =  press 
sigl(i)  =  sgl 

sig2(i)  =  sg2 

sig3(i)  =  sg3 

sig4 (i)  =  sg4 

sig5(i)  =  sg5 

sig6(i)  =  sg6 

ep(i)  =  plastrn 
epxl(i)  =  epxl(i)  +  deplstl 

epx2(i)  =  epx2(i)  +  deplst2 

epx3(i)  =  epx3(i)  +  deplst3 

epx4(i)  =  epx4 (i)  +  deplst4 

epx5(i)  =  epx5(i)  +  deplst5 

epx6(i)  =  epx6(i)  +  deplst6 

phi (i)  =  phit 
ebar(i)  =  ym 
cb(i)=sndspd 

davg (i) =third* (dl (i) +d2 (i) +d3 (i) ) 
effs(i)=q 

einc (i) =dl (i) *sigl (i) +d2 (i) *sig2 (i)+d4 (i) *sig4 (i)+d5 (i) *sig5 (i 
1  +d6 (i) *sig6 (i) +einc (i) +d3 (i) *sig3 (i) 

eyld (i) =stressO 
60  continue 
return 
end 
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APPENDIX  C.  DYSMAS  MODIFIED  SUBROUTINE  LISTINGS. 

blockdata  blkdat 

implicit  double  precision  (a-h,o-z) 
dp 

include  'nlqpar.inc' 
c 

c  ******  Added  Number  of  material  constants  for  material  type  44  - 
McDermott  '99 
c 


data 


nconst/0, 17, 5, 3,0,6, 12, 3,3, 4, 4, 0,1, 2, 5, 6, 10, 5, 2, 0,20, 14, 

1  2,0,2,0,12,5,5,9,12,18,25,0,20,44,11,8,10,25,14,5,26,16,16*0/ 


end 
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subroutine  dynai  (inelflg) 
implicit  double  precision  (a-h,o-z) 


c 

c  ****  Added  Support  for  Kwon-McDermott  Shell  Element  Formulation 
c  (Only  change  is  in  format  statement  227)  -  McDermott  '99 


C  ***  Changed  227  to  add  Kwon-McDermott  Formulation  -  McD 
227  format ( 

$  4x, 'shell  formulation  basis.... . ',i7/ 

$10x, ' eq.l:  hughes-liu  shell  theory  ',  / 

$10x, ' eq.2:  belytschko-lin-tsay  shell  theory  ',  / 

$10x, 'eq.3:  bciz  '/ 

$10x, 'eq.4:  cO-triangular  element  '/ 

$10x,'eq.5:  membrane  element  '/ 

$10x, 'eq.6:  yase  '/ 

$10x,  ' eq. 7 :  QPHM  '/ 

$10x, 'eq.8:  kwon-mcdermott  shell  'll 

$  4x, 'number  of  non-reflecting  boundary  segments . ',i7 // 

$  4 x, 'number  of  single  point  constraint  nodes . ' , i7 / / 

$  4x, 'number  of  spc  coordinate  system  definitions i7// 

$  4x,  '  reduction  factor  for  tsmin . 1 . ',el0.2// 

$  4x, '#  of  user  specified  beam  integration  rules . ' ,  i7 / / 

$  4x, 'max  number  of  integration  points  reqd  (beams)  . ' , i7 // 

$  4x, '#  of  user  specified  shell  integration  rules ....', i7// 

$  4x, 'max  number  of  integration  points  reqd  (shells) .', i7// 

$  4x, ' convergence  check  interval  (dynamic  relaxation) i7// 

$  4x,  ' convergence  tolerance  for  dynamic  relaxation. elO . 2/) 


end 
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subroutine  elem2d ( ixp, x, rhs , vt , vr , strain, yhatn,  f lbl ,  auxvec, 
lmtype, ro, cm, csprop, nsubgv,mtnum, nfegp, ihgq, hgq, xies, ener, rule, 
2mpusr, ishlfm, tfail, isf , lochvs, qextra, nshel, nncs, iblks, 

3  dampk, ym,pr, fails) 
implicit  double  precision  (a-h,o~z) 
dp 

include  'nlqpar.inc' 
c 

c  main  subroutine  for  calling  two-dimensional  elements 
c 

c  ***  Added  Kwon-McDermott  Shell  Formulation  -  McDermott  1999 


c  *********  ****************  ************* 
c  Kwon-McDermott  Shell  Formulation 
elseif  (iop.eq. 8)  then 

call  kwnmcd (rule, ixp, x, rhs, vt, vr, strain, yhatn,  fibl, auxvec, 

1  mtype, ro, cm, csprop, nsubgv,mtnum, nfegp,  ihgq,  hgq,  xies,  ener 

2  mpusr, lav, nmel, nnml,mxe, iblks, dampk (mxe)  ,  ym (mxe)  , pr (mxe) 

3  a (ns02+6*nnml) ) 


endif 


subroutine  fem3d  (rntype,  ro,  cm,  ic,  bcs,  npc,  pld,  nod,  idirn,  ncur,  clfac, 
11c,  nvel, vx, vy, vz, fval, rd, ilcw, nsw, numtp, nodtie,  tim,  iparm,  irects, 
2irectm, nsv,msr,nsegs, nsegm, lnsv, lmsr, ilocs, ilocm, stfs, stfm, 
3irtls, irtlm, xmsm, e, erst , b, tcode, u, v, a, x, xms, ac,  nsubgv,mtnum, 
4nfegp,  auxvec, rhsi, zfac, ieost, eosp, ihgq, hgq, iqtype,  bkqs, rbu, rbv, 
5rba,  rbi, rbm, rbcor, nrbn, nrba, nrb, xrb, yrb, zrb, axrb, ayrb, azrb, 

6rbfx, rbfy, rbfz, rbcods,mxrb, xyzkcn, lpntbk, lbcket, chrlen, ethik, 
7fric,  iseg,  fdat,  fthik,  ids,  irctsi,  irctmi, ilef ,  itcode,  atcode,  ifo, 
8slvfrc, msrfrc, ener, rots, failz, sfail, fl9s, tfail, isf , drdsps, nnfpln, 
9thkslv, thkmsr, failh, fails, ihlsnd, islsnd, ifalhl,  ifalsl,  ihl2sg, 

.  Iisl2sg,  isg2el,-iacthl,  iactsl,  irecta,  stfa,  thka,  isndsc,  stfsnd, 
2thksnd, thicks, ishltp, islfm, xnew, ftemp, xls, xlm, cntrls,  vract , mlbf , 
3bfact,  reetd, xndchr, thkseg, ityptp, iclsa, lclsa, nclsa,  accslv, accmsr, 
efu  4cornew, tmad,madmat, dbldat) 

4cornew,  tmad,madmat, dbldat , pfric,  weldf ) 


c  ***  Fixed  bug  in  disp, vel, accel, etc.  plot  file  write  counter  - 
McDermott  1999 


if (ncycle.ge. 1) goto  10 
cte 

output=. false. 
ncedit=0 
ioatb=0 
nfedit=0 
c 

c. . . .  check  for  variable  plot  interval,  get  load  curve  number 
c 

ipltlc=0 

if(  pltc  .It.  0.  )  then 
ipltlc=abs (pltc) 
endif 

c  ***  Changed  from  pltout=pltc  to  pltout=0.  to  print  1st  time  step  -  McD 
'99 


q  •k'k’ie'k'k'k-k'k’k'k'k'k'k'k’k’k-k'k’k-k’k'ir^r’k'k^-k’k'k’k-k'k-k'k^'k'k'k'kit'k'k 

c  BUG  FIX  FOR  PRINTOUT  INTERVAL  -  MCDERMOTT 

c  There  appears  to  be  code  already  written  to  do  this,  but  some 

c  are  commented  out.  This  was  a  temporary  fix  I  implemented, 

c 

if  (tt . lt.prtout)  go  to  160 

prtout=prtout+prtc 

if  (prtc . gt . endtim)  go  to  160 


end 
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subroutine  in3dis (x,matype, den,  prop, csprop, ipss,  yhat,  fibl, 

1  auxvec, lent, xnrvec, xmst, xmsr, numels,mx, ix, rbm, strain, beta, 

2  fval,tnew, ishlfm, nshl, fails) 
implicit  double  precision  (a-h,o-z) 

dP 

c 

c  called  by  ibmsh  for  shell  initialization 
c 

c  shell  initialization  (compute  mass  at  nodes) 
c 

c  call  in3dis (a (lcll) , a (nl) , a (n2 ) , a (n3) , a (n4f ) , a (lcls) , 
c  1  a (ns03) ,  a (ns05) , a (ns06) , a (lclO) , a (lclO+numnp) , a (lcl4) , 
c  2  a (lcl4+numnp) , numels, ix, ix (2 ) , a (n53) , a (nsOl) , a (ns04 ) , 
c  3  a (ni9) , a (ntmpl) , a (nl+nmmat) , a (nsl7 ) , a (nsl7+numels) ) 
c 
c 

c  a  shell  element 
c 

c  ***  Added  initialization  for  material  type  44  -  McDermott  1999 
c 


c  ***  Kwon-McDermott  -  Initialize  AUXVEC  for  material  44 
c 

if  (mte.eq.44)  then 
do  17  i=l,nmtcon 
17  auxvec (i+lav) =0 . 0 

c  Set  initial  porosity  and  yield  stress  . 

do  19  i=l,nip 

auxvec ( (i-1) *npi+15+lav) =prop (3,mx) 
auxvec ( (i-1) *npi+16+lav) =prop (4 ,mx) 

19  continue 
endif 


c 

c 


end 
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subroutine  matin (ieost, eosp, ihgq, hgq, iqtype,bqs, csprop, 

1  mtype, ishlfm, ro, cm, idfrs, nmmat, lc2 , mmauxs, iortho, ifb, isf , 

2  numelh, numels) 

implicit  double  precision  (a-h,o-z) 
dp 

c  '  . 

c  called  by  dynai  to  read  in  material  data 
c 

c  call  matin  (a (n4a) , a (n4b) , a (n4c) , a (n4c+nmmat) , a (n4d) , a (n4e) , 
c  1  a (n4f ) , a {nl ) , a (nl+nmmat ) , a (n2) , a (n3) , idfrs, nmmat, lc2, mmauxs, 
c  2  iortho, ifb, isf, numelh, numels) 
c 

c  ***  Added  Material  #44  (Elasto-plastic  w/void  effects)  and  allow 
c  Kwon-McDermott  shell  formulation  to  have  a  non-zero  reference 
c  McDermott  1999 

c 


c 

c  if  material  type  is  41 
c. . . .  fabric  model 
c 

if  (mtype (n) . eq. 41)  then 
if st=l 
ilst=3 
do  82  j=l,5 

call  gttxsg  (txts, lcount) 
if  (j.eq.l)  then 

read  (unit=txts, fmt=220, err=200)  (cm (i, n) , i=ifst, ilst) , cm (48, n) , 
1  (cm(i,n) , i=45, 47) 
elseif  (j.eq.2)  then 

read  (unit=txts, fmt=220,  err=200)  (cm (i, n) , i=if st, ilst) , 

1  cm (42, n) , cm(43, n) , cm (44,  n) , cm(41,n) 
elseif  .  ( j . gt . 2 . and. j . It . 5)  then 

read  (unit=txts, fmt=220, err=200)  (cm (i, n) , i=ifst, ilst) 
elseif  (j.eq.5)  then 

read  (unit=txts, fmt=220, err=200)  (cm(i,n) , i=ifst, ilst) 
endif 

ifst=ifst+3 
ilst=ilst+3 
82  continue 

call  gttxsg  (txts, lcount) 

read  (unit=txts, fmt=220, err=200)  (cm (i, n) , i=16, 18 ) , (cm (i, n) , i=26 
1  0) 
endif 

c  Kwon-McDermott 

c  material  type  44  (Elastic  Plastic  with  Void  Effects) 
if  (mtype (n) . eq. 44 )  then 
call  gttxsg  (txts, lcount) 

read  (unit=txts, fmt=220, err=200)  (cm (i, n) , i=l, 4 ) 
call  gttxsg  (txts, lcount) 

read  (unit=txts, fmt=220, err=200)  (cm(i,n) , i=5, 11) 

iseg=cm(ll,n) 

ifst=12 

do  25  j=l , 4 

if  (j.eq.3)  iseg=cm(ll,n) 
call  gttxsg  (txts, lcount) 
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c 


if  (iseg.ge.8)  then 
lread  =  8 
iseg  =  iseg  -  8 
else 

lread  =  iseg 
iseg  =  0 
endif 

if  (lread. gt.O)  then 

read  (unit=txts, fmt=220, err=200)  (cm (i, n) , i=if st , if st+lread) 
endif 

ifst  =  ifst  +8 
25  continue 

call  sets44 (cm(l,n) ) 
call  blkcpy (cm(l,n) ,prop, 48) 
endif 

*****************************************  *★**★*******■*-★■* 


c 

c  if  element  type  not  shell  goto  100 
c 

90  if  (itype.ne.2)  go  to  100 
csprop ( 14 , n) =0 . 0 
csprop ( 15, n) =0 . 0 
csprop ( 16, n) =0 . 0 

c  ***  Changed  to  allow  Kwon-McDermott  shell  to  have  non-zero  ref  -  McD 
1  99 

if  ( (ishlfm(n) .eq. 1 .and. irnxx. ge. 0) . or . (ishlfm(n) . eq. 8) )  then 


290  formate  ***warning***  the  reference  surface  must  be  the.',/, 

1  'midsurface  for  all  shell  elements  except  hughes-liu  or',/, 

2  ' kwon-mcdermott . ' ,  //) 


end 
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subroutine  nbsint  (irect, bulk, shear, nrt, cm, matype,  eosp,  ieost, 

1  numelh, bh, jxl, jx7, x, ro, nmmat) 
implicit  double  precision  (a-h,o-z) 
dp 
c 

c  called  by  initlz 
c 

c  if  number  of  non-reflecting  boundary  segments  (nnrbs)  greater 
c  than  zero  call  subroutine  nbsint  to  initialize  transmitting 
c  boundary  segments 
c 

c  if  (nnrbs. gt.O)  then 

c  call  nbsint  (b (lrbl) , b (lrb2) , b (lrb3) , nnrbs, cm,mtype, eosp, ieost 

c  &  numelh, ipsh, b (ibinsl) , b (ibins2) , x, ro, nmmat) 
c  endif 

c 

c  ***  Added  support  for  Mat  #44  -  McDermott  1999 
c 


if  (mt.eq.43)  then 

bkm (mx) =cm (48* (mx-1) +1) /3 . 
shm  (mx)  =cm  (48*  (mx-1) +1) /2  . 
endif 

c  ***  Elasto-Plastic  with  Void  Effects 
if  (mt.eq.44)  then 

bkm (mx) =cm(48* (mx-1) +1) /(3.*(l.-2.*cm(48* (mx-1)  +2) ) ) 
shm (mx) =cm( 48* (mx-1) +1 ) / (2 . * ( 1 . +cm (48* (mx-1) +2) ) ) 
endif 

c  ********************************  mcd  >99 


subroutine  penstf  (x,  nrb,  xyzkcn, rbncod,  ipsh, ipss, ipsb, cm,matype, 

1  eosp, ieost, numelh, numels, numelb, nmmat, ro, zf, thicks, fibers, 

2  ishlfm) 

implicit  double  precision  (a-h,o-z) 
dp 
c 

c  called  by  initlz  to  compute  locations  of  extra 
c  rigid  body  points 
c 

c  call  penstf  (x, nrb,  xyzkcn,  rbncod,  ipsh, b (lcls) ,b (lclb) , cm,mtype, 
c  leosp, ieost, numelh, numels, numelb, nmmat, ro, zfcs, b (ns 05) , 
c  2  b (nb05) ,b (nl+nmmat) ) 
c 


if  (mt . eq. 41 ) bkm (mx) =cm (mx48ml+21) 
c  ***  Elasto-Plastic  with  Void  Effects  -  McD  '99 

if  (mt.eq.44)  bkm (mx) =cm(mx48ml+l) / (3 . * ( 1 . -2 . *cm (mx48ml+2) ) ) 


subroutine  printm  (n,mod, ro, cm, ieost, eosp,  ihgq,hgq,  iqtype,bqs, 

1  csprop,  head,  ityjie,  angles,  thrmpr,  nip,  ishlfm) 
implicit  double  precision  (a-h,o-z) 
dp 
c 

c  called  by  matin  to  write  out  (echo)  material  properties 
c 

c  170  call  printm  (n, mtype (n) , ro (n) , cm ( 1, n) , ieost (n) ,  eosp (1, n) , ihgq (n) 
c  1  ,  hgq (n) , iqtype (n) ,bqs (1, n) , csprop (1, n) , head, itype, a (langle) , a 
c  2  (lthrpr) , nip, ishlfm (n) ) 
c 

c  subroutine  to  print  out  material  properties 

c 

c  ***  Added  Mate  #44  (Elasto-Plastic  with  Void  Effects)  -  McDermott  1999 
c 


c 

go  to  (10, 20, 30, 40, 50, 60, 70, SO, 90, 100, 110, 120, 130, 140, 150, 160, 170, 
1  180,190,10,200,210,230,250,260,270,272,30,274,30, 

1  275,276,277,278,279,281,282,283,284,105,107,285,286,287) ,  mod 


c 

c  model  -  44  Elastic-Plastic  w/Void  Growth  &  Nucleation,  piecewise 
c  linear  strain  hardening 

c  McDermott  1999 

c 

287  write  (13,1700)  (cm(i) , i=l, 10) , int (cm (11) ) 
write  (13,1701) 

do  288  id=l, int (cm(ll) ) 
indl  =  13+2* (id-1) 
ind2  =  12+2* (id-1) 

write  (13,1702)  (cm (indl) , cm (ind2) ) 

288  continue 
write  (13, 1703) 

•  go  to  280 


eg. 30  closed  form  update  elastic-plastic  for  shells  '/, 

eq.31  frazer-nash  hyperelastic  rubber'/, 

eq.32  ramberg  osgood  elastic-plastic'/, 

eq.33  hill  general  anisotropic  plasticity'/, 

eq.34  hill  normal  anisotropic  plasticity  for  shells'/, 

eq.35  elastic-plastic  with  forming  limit  diagram'/, 

eq.36  brittle  damage  (experimental)  '/, 

eq.37  3-invariant  viscoplastic  cap  '/, 

eq.38  bammann  plasticity  '/, 

eq.39  sandia  damage  '/, 

eq.40  fahrenthold  brittle  damage  '/, 

eq.41  fabric  '/, 

eq.42  MTS  '/, 

eq.43  Low  Density  Polyurethane  Foam  '/, 
eq.44  Elastic-Plastic  with  Void  Effects'//) 


321  format ( 
$ 

$ 

$ 

$ 

$ 

$ 

.$ 

$ 

$ 

$ 

$ 

$ 

$ 

$ 

$ 
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810  format ( 

$  5x,  ' shell  formulation  .  =',i5/ 

$  5x, '  eq.  1:  hughes-liu  '/ 

$  5x,  '  eq.  2:  belytschko-tsay  '/ 

$  5x,  '  eq.  3 :  bciz  •'  / 

$  5x,  '  eq.  4:  cO-triangular  element  '/ 

$  5x, '  eq.  5:  membrane  element  '/ 

$  5x, '  eq.  6 :  yase  '  / 

$  5x, '  eq.  7:  QPHM  ’/ 

$  5x, '  eq.  8:  kwon-mcdermott  element  '// 

1  5x,  'fiber  lengths:  node  1  .  =',  el2.4/ 

2  5x,  '  node  2  .  =  ',  el2.4/ 

3  5x,  '  node  3  .  =  ',  el2.4/ 

4  5x,  '  node  4  .  =  ',  ell. A// 

5  5x, ' reference  surface:  node  1  .  =  ',  el2.4/ 

6  5x,  '  eq.  1.0:top  node  2  .  el2.4/ 

7  5x,  '  eq.  0.0:middle  node  3  .  =  ',  el2.4/ 

8  5x,  '  eq. -1 . 0 :bottom  node  4  .  =',  ell.  All) 


1700  format ( 

1  5x,  ' youngs  modulus  .  =  ',  el2.4/ 

2  5x, 'poissons  ratio  .  = ' ,  el2.4/ 

3  5x, 'initial  porosity  .  =  ',  el2.4/ 

4  5x, 'yield  stress  .  =  ',  el2.4/ 

5  5x, 'ql  of  gursons  model  .  =',  el2.4/ 

6  5x, 'q2  of  gursons  model  .  =',  el2.4/ 

7  5x, 'q3  of  gursons  model  .  =',  el2.4/ 

8  5x, 'void  nucleation  content  (fn)  .  =',  el2.4/ 

9  5x, 'mean  nucleation  strain  (en)  .  =',  ell. A/ 

1  5x, 'nucleation  standard  deviation  (sn)  =',  el2.4/ 

2  5x, 'number  of  segments  in  hardening  ..  =',  i5/) 

1701  format ( 

1  5x, 'stress  strain  curve  points:',/ 

2  7x, 'strain  slope') 

1702  format (5x, el2 . 4, '  ’,el2.4) 

1703  format (/) 
c 

end 
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subroutine  prtdat  (mpri, nfegp, nsubgv, u, b, x,mtnum, cm, accls) 
implicit  double  precision  (a-h,o-z) 
dp 
c 

c  called  by  fem3d  at  various  time  during  the  solution 
c  phase  to  write  taurus  database 
c 

c  two  types  of  calls 
c 

c  call  prtdat  (-1, nfegp, nsubgv, u, b, x,mtnum, cm, a) 

c 

c  call  prtdat  (+1, nfegp, nsubgv, u, b, x,mtnum, cm, a) 

c 

Q  ***************************  **************  * 

c  The  logic  for  mpri  was  incorrect:  previously  if  mpri  >0  and  mkthf 
c  =0,  the  same  action  is  taken  as  if  mpri  <  0.  This  causes  the 
disp, 

c  velo,  and  contour  files  to  written  twice  at  each  print  step.  New 
c  logic  applied  so  that  it  works  as  it  appears  it  should: 
c  mpri  =  -1  ->  print  disp,  geometry,  velo,  contours,  etc. 

c  mpri  =  +1  ->  print  history  files  iff  mkthf  ne  0 

c  McDermott  1999 

q  •k'k’k'k’k'k'k'k'je'k'k'k'ie'k’k'k'k'k'k'ie’k'k'k'k'k'ie'k’k'k'k’k'k'k'k'k'ic'k'le'k'k'k'k'ie'k-k'Jr’tc'k'ic 


c  ***  This  code  causes  the  plot  files  to  be  written  twice  at  each  print 
step 

c  New  logic  applied.  McD  -  ’ 99 

c  if  (  mpri  .gt.O  .and.  mkthf  .ne.  0  )  go  to  130 

c  if (mpri . It . 0)  go  to  10 

if  (mpri. gt.O)  goto  130 


c 

end 


130 


o  o  o 


C 

C 

C 

C 

C 

C 

C 

C 


SUBROUTINE  SCA_ASC  (  X,  V,  ACC,  XO,  NCPOUT,  A,  PFRIC) 

CALLED  BY  PRTDAT  TO  WRITE  SCALAR  PLOT  FILES  (ASCII-FORMAT) 
REIHENFOLGE  WICHTIG  ! !  ! 

1. )  VOLUMENELEMENTE 

2. )  BALKENELEMENTE 

3. )  SCHALENELEMENTE 

4. )  DICKE  SCHALENELEMENTE 


C..  CALL  SCA_ASC  (A(LC11) ,A(LC9) , A(LC10) , A(LC13)  , A(NCPLL) , A(l) 
C 


A  (LC12 ) ) 


c  Added  Code  for  AUX14  variables  #15  and  16  (Porosity  and  Yield  stress 
c  in  Material  #44)  -  McDermott  -  '99 

q* *********************  ************************************************ 


c  ****  Used  for  SCA_GET  -  McDermott 
dimension  val(nlq) 

C 


SHELLELEMENTS 

140  IF  (NUMELS.EQ. 0)  GOTO  240 
NELG=NUMELS/nlq 

IF  (nlq*NELG . LT . NUMELS )  NELG=NELG+1 
C 

NEL=0 

c  Seperate  Counter  for  SCA_GET  -  McDermott 
nelget=0 

NUMEL  =  NUMELH  +  NUMELB  +  NUMELS 
DO  200  NN=1 , NELG 
NMEL=nlq 

IF  (NN.EQ.NELG)  NMEL=NUMELS-nlq* (NELG-1) 

LNS=4  9 

CALL  SCALARS (A(N1) , A(N4F) ,A(LC11) , A(N4A) , A(LC1S) , A(NS05) , 

F  A(NS06) ,A(NS03) ,A(NS01) ,SIG,  LNS, A (NS07 ) , A (N4H) , 

F  ..  . MPUSR, A (Nl+NMMAT)  ,A(NSTSL)  ,A(NS13)  ,A(NS14)  ,NEL, 

F  NMEL, A (NS02 )  ,  EMAIN) 

C 

c  *****  Changed  to  support  Void  Material  (#44)  -  McDermott 

GOTO  (141,142,180,180,180,180,180,180,180,180,180,180,180,180, 
c  F  180,180,180,  180,  180,  180,  180,  180,  180,  180,  180,  180,  180,  180,  180, 
F  155, 156, 157, 158,180, 180,180,180,180, 180, 165,180, 180,180, 180, 

F  170,171,172,173,174,175,176,177,178,179)  K 


c 

c  ****************  Support  for  Void  Material  (#44)  -  McDermott 
c  Void  Content 
157  continue 
ival=15 

call  sca_get  (a (nl) , a (n4f ) , a (lcll) , a (n4a) , a (lcls) , a (ns06) , 
1  sig, Ins, a (ns 13) , a (ns 14 ) ,  nelget , nmel,  ival,  val, iint) 

do  i=l,nmel 
il  =  i  +  (nn-l)*nlq 
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c 


write ( 91,  ' (lx, i7, lx, E12 . 5)  ’ )  il, sngl (val (i) ) 
end  do 

goto  200 

c  Yield  Stress 
158  continue 
ival=16 

call  sca_get  (a (nl) , a (n4f ) , a (lcll) , a (n4a) , a (lcls) , a (ns06) , 
1  sig, Ins, a (ns 13 ) , a (ns 14 ) , nelget, nmel, i val, val, iint ) 

do  i=l,nmel 
il  =  i  +  (nn-l)*nlq 

write ( 91,  ' (lx, i7, lx, E12 . 5) ' )  il, sngl (val (i) ) 
end  do 
c 

goto  200 

c  *********************************************************** 
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ooo-  •  •  <->•  •  •  oooooooo 


SUBROUTINE  SCA_DYS  (  X,  V,  ACC,  XO,  NCPOUT,  A,  PFRIC) 

. .  CALLED  BY  PRTDAT  TO  WRITE  SCALAR  PLOT  FILES  (DYSMAS/P  FORMAT) 

.  .  CALL  SCA_DYS  (A (LC11 ) , A(LC9) , A (LC10 ) , A (LC13) , A (NCPLL) , A ( 1 ) , A (LC12 ) ) 

Added  Support  for  printing  auxl4  variables  15  and  16  (porosity  and 
yield  stress  in  Mat  #44  -  McDermott  1999 
********************************************************************** 


****  Used  for  SCA_GET  -  McD  '99 
dimension  val(nlq) 


SHELL  ELEMENTS 

140  IF  (NUMELS . EQ. 0)  GOTO  240 
NELG=NUMELS/nlq 

IF  (nlq*NELG.LT. NUMELS)  NELG=NELG+1 
ikon=ikon+l 
C 

NEL=0 

c  Seperate  Counter  for  SCA_GET  -  McDermott 
nelget=0 

NUMEL  =  NUMELH  +  NUMELB  +  NUMELS 
NUMEL1  =  NUMELH  +  NUMELB 
DO  200  NN=1, NELG 
NMEL=nlq 

IF  (NN.EQ.NELG)  NMEL=NUMELS-nlq* (NELG-1) 

LNS=4  9 

CALL  SCALARS (A(N1) ,A(N4F) ,A(LC11) ,A(N4A) ,A{LC1S)  ,A(NS05) , 

F  A (NS06 ) , A (NS03 ) , A (NS01 ) , SIG, LNS, A (NS07 ) , A (N4H) , 

F  MPUSR, A (Nl+NMMAT) ,A(NSTSL) ,A(NS13)  ,A(NS14) ,NEL, 

F  NMEL, A(NS02) , EMAIN) 

C  ****  added  57  and  58  -  McD 

GOTO  (141,  142,  180,  180,  180, 180,  180,  180,  180,  180,  180,  180,  180,  180, 
c  F  180,  180,  180,  180,  180,  180,  180,  180,  180, 180,  180,  180,  180,  180, 180, 
F  155, 156, 157, 158,180,180, 180, 180,180, 180, 165, 180, 180, 180,180, 

F  170,171,172,173,174,175,176,177,178,179)  K 


c  ****************  Support  for  Void  Material  (#44)  -  McD  '99 
c  Void  Content 
157  continue 
ival=15 

call  sca_get  (a (nl ) , a (n4f ) , a (Icll) , a (n4a) , a (lcls) , a (ns06) , 
1  sig, Ins, a (ns 13) , a (ns 14 ) , nelget, nmel, ival, val, iint) 

do  i=l,nmel 
il  =  i  +  (nn-l)*nlq 

write  (91,  '  (lx,  i7, lx, E12 . 5) ' )  il, sngl (val (i) ) 
end  do 
c 

goto  200 


c 
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c  Yield  Stress 
158  continue 
. ival=16 

call  sca_get  (a (nl) , a (n4f ) , a (lcll ) , a (n4a) , a (lcls) , a (ns06) , 
1  sig.  Ins,  a  (nsl3) ,  a  (ns  14 ) ,  nelg'et, nmel,  ival,  val,  iint ) 

do  i=l,nmel 
il  =  i  +  (nn-l)*nlq 

write ( 91, ' (lx, i7, lx, E12 . 5) ' )  il, sngl (val (i) ) 
end  do 
c 

goto  200 

q  'k'k'k'k-kie'k'te'k'k'k'k'k'k'k'k'te'k’k'k’k'k'k'k’k'k'k'k’k'k'je'Jc-k&'k'k'k'k-k'k'k'k’fe'k'k-k'k'k  ★ 


END 
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SUBROUTINE  SCA_TEC  (  ACC,  NCPOUT,  A,  PFRIC, 

1  nhxpnt, nshpnt , ntxpnt, ixh, ixs, ixt,  ss, ival  ) 

C 

C  CALLED  BY  PRTDAT  TO  WRITE  SCALAR  PLOT  FILES  (TECPLOT- FORMAT) 

C  REIHENFOLGE  WICHTIG  ! ! ! 


c 

1.) 

VOLUMENELEMENTE 

c 

nicht 

2.) 

BALKENELEMENTE  (werden  von  TECPLOT 

C 

unterstuetzt) 

C 

3.) 

SCHALENELEMENTE 

C 

4.) 

DICKE  SCHALENELEMENTE 

C 

C  CALL  SCA_TEC  (  A(LC10),  A(NCPLL),  A(l),  A(LC12)) 

C 

C  '  Fuchs  1 97 

c  ***  Variables  written  to  scratch  file  must  be  same  precision  as 
c  variable  used  to  read  back  -  fixed  (removed  sngl()),  added 
c  support  for  auxl4  variables  #15  and  16  (Porosity  and  Yield  stress  for 
c  Material  #44  -  McDermott  1 99 

c********************************************************************** 

implicit  double  precision  (a-h,o-z) 
dp 

include  'nlqpar.inc' 

COMMON /BKOO/NUMNP, NUMPC, NUMLP, NEQ, NDOF, NLCUR, NUMCL, NUMVC, 

1  NDTPTS, NELMD, NMMAT , NUMELH , NUMELB, NUMELS,  NUMELT,  NUMDP, 

2  GRVITY, IDIRGV, NODSPC, NSPCOR 

cfu 

common/bk03/endtim, prtc, pltc, ndthl, nsthl, nstsl, nstbl, nsttl,mkthf 
common/bk03/endtim, prtc, pltc, ngthl, ndthl, nsthl, nstsl,  nstbl, 

1  nsttl, ncpll,mkthf 

COMMON /BKO  4 /PRTOUT , PLTOUT, DT20LD, SLSFAC, TSSFAC, I HYDRO, 
cfu  1  NDTH, NMST, NSTH, NSTS, NSTB, NSTT, IKEDIT 

1  ngth, ndth, nmst, nsth, nsts, nstb, nstt, ncpl, ikedit 
COMMON/BK05/ 

1  NH01, NH02, NH03, NH04, NH05, NH06, NH07, NH08, NH09, NH10, 

2  NB01 , NB02, NB03, NB04 , NB05, NB06, NB07, NB08 , NB09, NB10 , 

3  NS01 , NS02, NS03, NS04 , NS05 , NS06, NS07 , NS08 , NS09, NS10 , 

4  NT01 , NT02, NT03, NT04 , NT05, NT06, NT07, NT08 , NT09, NT10 
REAL *8  HEAD 

VAX750 

common/bk06/time (2,8), head (12) , idmmy, iadd, ifil,maxsiz,  ncycle 
Common/bk07/nl,n2,n3,n4,n5,n6,n7,n8,n9,nl0,nll,nl2,nl3,nl4,nl5, 

1  nl6,  nl7 , nl8, nl9, n20, n21, n22, n23, n24, n25, n2  6, n27, n28, n29, n30, n31, 

2  n32,n33,n34,n35,n36,n37,n38,n39,n40,n41,n42,n43,n44,n45, 

3  n4  6, n47, n48, n4  9, n50, n51, n52, n53, n54 , n55, n56, n57, n58, n59, n60, n61, 

4  n62, n63, n64 , n65, n66, n67, n68, n69, n70, n71, n72, n73, n74, n75, n76, n77 , 

5  n78, n79, n80, n81, n82, n83, n84 , locend, iname, lend 
common/bk08/n4a, n4b, n4c, n4d, n4e, n4f , n4g, n4h, n7a, n7b, n7c, n7d, n7e, 

1  nusir,mpusr,mpubr 

COMMON/BK13/LCO, LC1H, LC1B, LC1S, LC1T, LC2, LC3, LC4 , LC5, LC6, LC7 , LC9, 

1  LC10 , LC11 ,  LC12, LC13, LC14 , LC15, LC16, LC17 , LC18 , LBO , LB1 , LB2 , 

2  LC7A, LC7B 

COMMON /BK2  0 /NUMS V , JU, JV, NRTM, NRTS, NMN, NSN, NTY, NST, MST, NOCO 
COMMON / BK2 8 / S UMMS S , XKE , X PE ,  T T 
COMMON/AUX14 /SIG (49, nlq) 

COMMON/SHLOPT/ISTRN, ISTUPD, IBELYT,  MITER 
common/sorter/nnc, Iczc, 

6  ns 1 1,  nsl2, ns 13, ns 14, ns 15, ns 16, ns 17, 

&  nhll,  nhl2, nhl3, nhl4 , nhl5, nhl6, nhl7, 

&  ntll, ntl2, ntl3, ntl4 , ntl5, ntl6, ntl7, 
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noon 


C 


c 


&  nbll, nbl2, nbl3, nbl4 , nbl5, nbl6, nbl7 
COMMON / I N KT H /  INCHIS,  NPOST,  NDISP,  NVELO,  NCYREM, 
1  NSTRESS,  NSTRAIN 

CHARACTER* 8  DATU,VS 
CHARACTER* 60  SBTEXT(20) 

COMMON /VSNUM/VS, DATU 

CHARACTER  MOFI*13, COD*3,  CODl*6,  GEOTIT*13 
CHARACTER  VARCHAR*84,  ELT*27 


DIMENSION 
DIMENSION 
DIMENSION 
dimension 
dimension 
****  Used  for 
dimension 


ACC (3,*),  NCPOUT  £*) ,  A(*) 

VLSTRAI ( 7 , nlq) ,  PFRIC(*),  EMAIN ( 6, nlq) 
SS(*),  VAL1 (7) ,  IVAL { * ) 
ixh ( 9 , * ) , ixs ( 5 , * ) , ixt ( 9 , * ) 
nhxpnt ( * ) , nshpnt ( * ) , ntxpnt ( * ) 

SCA_GET  -  McD  99 
val (nlq) 


c 

IF  (  NCPL  .EQ.  0  )  RETURN 
C 

DO  500  J=1 , NCPL 
11=0 

K=NCPOUT ( J) 

IF  ( K . GE . 8 1 . AND . K . LE . 9 9 )  GOTO  500 
C 

WRITE  (COD1, ' (16) ' )  NCYCLE 
WRITE  (COD, ' ( 13 ) ' )  K 
IF  (K.LT.100)  COD ( 1 : 1 )  = '  0  ' 

IF  (K.LT.10)  COD ( 2 : 2 ) = ' 0 ' 

C 

IF  (NCYCLE.LT. 100000)  COD1 (1 : 1 ) = ' 0 ' 

IF  (NCYCLE.LT. 10000)  COD1 (2 : 2 ) = ' 0 ' 

IF  (NCYCLE.LT. 1000)  COD1 (3 : 3) =' 0 ' 

IF  (NCYCLE.LT. 100)  COD1 ( 4 : 4 ) = ' 0 ' 

IF  (NCYCLE.LT. 10)  COD1 (5: 5)=' O' 

C 

MOFI (1:3)  =  'TEC' 

MOFI (4:9)  =  COD1 
MOFI (10: 13)=' . '//COD 
C 

IINT=1 

IF  (K.GT.99)  THEN 
K=NCPOUT (J) /10 
IINT=NCPOUT ( J) -10*K 
ENDIF 
C 

IF  {  K  .LE.  40  .AND.  K  .NE.  19)  GOTO  500 
IF  (  K  .GE.  43  .AND.  K  .LE.  54  )  GOTO  500 
C 

OPEN  (UNIT=91, POSITION= ' REWIND ' , STATUS= ’ SCRATCH ' , 

1  FORM= ' UNFORMATTED ' ) 

OPEN  ( UNIT=93, STATUS= ' UNKNOWN ' , FILE=MOFI , FORM= ' FORMATTED ' ) 
C 

IF  (K.EQ.19)  GOTO  19 
GOTO  40 


KNOTNWERTE 


GOTO (1,2, 3, 500, 500, 500, 500, 500, 500, 500, 500, 500, 500, 500, 500, 500, 500 
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non  onn  n  o  ooo  ooo 


C  1  , 500, 19) K 

C  BESCHLEUNIGUNGEN 
C  1  CALL  KN0_ASC  (ACC, 1, NUMNP) 

C  GOTO  490 

C  2  CALL  KN0_ASC  (ACC, 2, NUMNP) 

C  GOTO  490 

C  3  CALL  KNO_ASC  (ACC, 3, NUMNP) 

C  GOTO  490 

C 

C  REIBLEISTUNG  (noch  nicht  im  richtigen  TECPLOT-Format  implementiert) 
C 

19  CONTINUE 
KTYP=0 
MW=1 
LF=1 

WRITE(93,  '  (315)  ' )  KTYP, MW, LF 
WRITE (93,*)  '  * 

WRITE (93,*)  '  ' 

DO  5291  IS=l,numnp 

5291  WRITE  (93, ' (IX, 17, IX, E12 . 5) ')  IS,  sngl (PFRIC (IS) ) 

GOTO  490 

ELEMENTWERTE 

40  K=K-40 
DUMMY=0 . 

HEXAHEDRONS 

IF  (  NUMELH  .EQ.  0  )  GOTO  140 
NELG=NUMELH/nlq 

IF  (nlq*NELG.LT. NUMELH)  NELG=NELG+1 
NEL=0 

DO  100  NN=1 , NELG 
NMEL=nlq 

IF  (NN.EQ.NELG)  NMEL=NUMELH-nlq* (NELG-1) 

CALL  SCALARH  (A (LC1H) , A (LC15) , A (N1 ) , A (NH13 ) , A (NH14 ) , A (NH04 ) , 

1  VLSTRAI , NEL, NMEL) 

GOTO  (41, 42, 100, 100, 100,100,100, 100, 100, 100, 100, 100,100,100, 

F  80,80,80,58,80,80,80,80,80,80,65,80,80,80,80, 

F  80,80,80,80,80,80,80,80,80,80)  K 

HUBER-MISES-HENCKY  -  VERGLEICHSSPANNUNG 

41  DO  410  Jl=l , NMEL 

410  WRITE  (91)  SIG ( 8 , J1 ) 

GOTO  100 

PLAST.  VERGLE I CHS  DEHNUNG 

42  DO  420  Jl=l , NMEL 

420  WRITE  (91)  SIG(7,J1) 

GOTO  100 
C  P-HYD 

58  DO  580  Jl=l , NMEL 
580  WRITE  (91)  SIG(20,J1) 

GOTO  100 

C  EQUIVALENT  STRAIN  RATE 
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65  DO  650  Jl=l , NMEL 
650  WRITE  (91)  VLSTRAI ( 7 , J1 ) 

GOTO  100 
C 

C  BE I  GROESSEN,  DIE  FUER  VOLUMENELEMENTE  NICHT  ZUR  VERFUEGUNG  STEHEN 

C  MUESSEN  BE I  GEOMETRIEN  MIT  GEMISCHTEN  ELEMTTYPEN  DIESE  FELDER  MIT 

C  NULL  BELEGT  WERDEN 
C 

80  DO  81  Jl=l, NMEL 
81  WRITE (91)  DUMMY 
100  CONTINUE 
C 

C  BEAM  ELEMENTS 
C 

140  IF  (  NUMELB  .EQ.  0  )  GOTO  240 
NELG=NUMELB/nlq 

IF  (nlq*NELG.LT. NUMELB)  NELG=NELG+1 
C 

NEL=0 

DO  300  NN=1, NELG 
NMEL=nlq 

IF  (NN.EQ.NELG)  NMEL=NUMELB-nlq* (NELG-1) 

LNS=7 

CALL  SCALARB  (A (NB04 ) , A (NB13 ) , SIG, NMEL, NEL, LNS ) 

C 

C  !  !  K  E  I  N  E  !  ! 

C  HUBER-MISES-HENCKY  -  VERGLEICHSSPANNUNG  UND 
C  SPANNUNGEN  IM  GLOBALEN  KOORD.-SYST. 

C  SIG-XX,  SIG-YY,  SIG-ZZ,  SIG-XY,  SIG-YZ,  SIG-ZX 
C 

C  PLAST.  VERGLEICHSDEHNUNG  UND 
C  DEHNUNGEN  IM  GLOBALEN  KOORD.-SYST. 

C  !  !  VORHANDEN  !! 

C 

c 

GOTO  (280,280,280,280,280,280,280,280,280,280,280,280,280,280, 

F  280,280, 280, 280, 280,280, 280, 280,280,280, 280,280, 280,280,280, 

F  270,271,272,280,274,275,280,277,280,280)  K 

C 

C  RESULTIERENDE  SCHNITTLASTEN 
C 

C  MOMENT -S 

270  DO  27  Jl=l, NMEL 

27  WRITE  (91)  SIG ( 4 , J1 ) 

GOTO  300 

C  MOMENT -T 

271  DO  28  Jl=l, NMEL 

28  WRITE  (91)  SIG (5, Jl) 

GOTO  300 

C  TORSION 

272  DO  29  Jl=l , NMEL 

29  WRITE  (91)  SIG ( 6, Jl ) 

GOTO  300 

C  SHEAR-T 

274  DO  30  Jl=l, NMEL 

30  WRITE  (91)  SIG (3, Jl) 

GOTO  300 

C  AXIAL 

275  DO  31  Jl=l, NMEL 

31  WRITE  (91)  SIG ( 1 , Jl ) 
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GOTO  300 
C  SHEAR-S 

277  DO  32  J1=1,NMEL 

32  WRITE  (91)  SIG (2, J1 ) 

GOTO  300 

280  DO  33  Jl=l, NMEL 

33  WRITE  (91)  DUMMY 
300  CONTINUE. 

SHELL  ELEMENTS 

240  IF  (  NUMELS  .EQ.  0  )  GOTO  340 
NELG=NUMELS/nlq 

IF  (nlq*NELG.LT. NUMELS)  NELG=NELG+1 
NEL=0 

***  New  counter  to  support  SCA_GET  -  McDermott 
nelget=0 

DO  200  NN=1, NELG 
NMEL=nlq 

IF  (NN.EQ.NELG)  NMEL=NUMELS-nlq* (NELG-1) 

LNS=4  9 

CALL  SCALARS  (A(N1) ,A(N4F) ,A(LC11) ,A(N4A) , A(LC1S) ,A(NS05) , A(NS06) , 
F  A  (NS03) ,A(NS01) , SIG, LNS, A (NS07 ) ,A(N4H) ,MPUSR, 

F  A (Nl+NMMAT) ,A(NSTSL) ,A(NS13) , A (NS14 ) , NEL, NMEL, 

F  A(NS02) ,EMAIN) 

***  Added  57  and  58  -  McD  '99 

.  GOTO  (141, 142,200,200,200,200,200,200,200,200,200,200,200,200, 

F  155,  156,  180,  180,  180,180,  180,  180,  180, 180,  165,  180,  180,  180,  180, 

F  155,  156,  157,  158, 180,180,  180,  180,  180, 180, 165,  180,  180,  180,  180, 

F  170,171,172,173,174,175,176,177,178,179)  K 

HUBER-MISES-HENCKY  -  VERGLE ICHS S PANNUNG  UND 
SPANNUNGEN  IM  GLOBALEN  KOORD.-SYST. 

SIG-XX,  SIG-YY,  SIG-ZZ,  SIG-XY,  SIG-YZ,  SIG-ZX 

141  DO  36  Jl=l , NMEL 

6  WRITE  (91)  SIG ( 8+ ( IINT-1) *8 , J1 ) 

GOTO  200 

PLAST.  VERGLEICHSDEHNUNG  UND 

VERZERRUNGEN  AN  DER  UNTER-  UND  OBERSEITE  DER  PLATTE 
( IINT=1 :  UNTERSEITE,  IINT=2:  OBERSEITE)  IM  GLOBALEN  KOORD.-SYST. 
EPS-XX/  EPS-YY,  EPS-ZZ,  EPS-XY,  EPS-YZ,  EPS-XZ, 


142  DO  37  Jl=l , NMEL 

7  WRITE  (91)  SIG (7+ (IINT-1 ) *8 , J1 ) 

GOTO  200 


principal  strains  EPS-I,  EPS-II,  strain  rate 

155  DO  15  Jl=l, NMEL 

WRITE  (91)  EMAIN (1+3* (IINT-1) ,J1) 

15  CONTINUE 
GOTO  200 

156  DO  16  Jl=l , NMEL 

WRITE  (91)  EMAIN (2+3* (IINT-1) ,J1) 

16  CONTINUE 
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GOTO  200 


c 

c  ****************  support  for  Void  Material  (#44)  -  McD  '99 
c  Void  Content 

157  continue 
icode=15 

call  sca_get  (a (nl) , a (n4f ) ,  a (lcll)  ,  a (n4a) ,  a (lcls)  ,  a (ns06) 
1  sig, Ins, a (ns 13) , a (nsl4 ) , nelget, nmel, icode, val, iint) 

do  i=l,nmel 
il  =  i  +  (nn-l)*nlq 
write (91)  val(i) 
end  do 
c 

goto  200 
c 

c  Yield  Stress 

158  continue 
icode=16 

call  sca_get  (a (nl) , a (n4f ) , a (lcll) , a (n4a) , a (lcls) , a (ns06) 
1  ■  sig, Ins , a (nsl3) , a (nsl4 ), nelget , nmel, icode, val, iint ) 

do  i=l,nmel 
il  =  i  +  (nn-l)*nlq 
write (91)  val(i) 
end  do 
c 

goto  200 

q  •fe-jc'k-k'k'ie-je’k’k'k'k'ie-tc-k’k’k'k'k-k’k'k'k-Jr'k-k’k'k'k-k'k'k'k’k^k'Jc-k'k-k’k'k'k'k-k'k-k'k'k-k'kie-k'k’k'k’k'k-k'kic 

c 

165  DO  17  Jl=l , NMEL 

WRITE  (91)  EMAIN (3+3* ( IINT-1 )  ,  J1 ) 

17  CONTINUE 
GOTO  200 

RESULTIERENDE  SCHNITTLASTEN 
M-XX 

170  DO  18  Jl=l, NMEL 

18  WRITE  (91)  SIG (25, Jl) 

GOTO  200 

C  M-YY 

171  DO  14  Jl=l, NMEL 

14  WRITE  (91)  SIG (26, Jl) 

GOTO  200 

C  M-XY 

172  DO  20  Jl=l, NMEL 

20  WRITE  (91)  SIG (27 , Jl ) 

GOTO  200 

C  Q-XX 

173  DO  21  Jl=l, NMEL 

21  WRITE  (91)  SIG (28 , Jl ) 

GOTO  200 

C  Q-YY 

174  DO  22  Jl=l, NMEL 

22  WRITE  (91)  SIG(29, Jl) 

GOTO  200 

C  N-XX 

175  DO  23  Jl=l , NMEL 

23  WRITE  (91)  SIG (30, Jl)  • 

GOTO  200 


140 


oononn  o  o  ooo  o  o  ooo 


C  N-YY 

176  DO  24  Jl=l, NMEL 

24  WRITE  (91)  SIG (31, Jl) 

GOTO  200 

C  N-XY 

177  DO  25  Jl=l, NMEL 

25  WRITE  (91)  SIG (32, Jl) 

GOTO  200 

C  PLATTENDICKE 

178  DO  26  Jl=l , NMEL 

26  WRITE  (91)  SIG ( 33, Jl ) 

GOTO  200 

C  ENERGIEDICHTE 

179  DO  34  Jl=l , NMEL 

34  WRITE  (91)  SIG ( 48 , Jl ) 

GOTO  200 

C  DUMMY 

180  DO  35  Jl=l, NMEL 

35  WRITE  (91)  DUMMY 
200  CONTINUE 

THICK  SHELLS 

340  IF  (NUMELT.EQ.O)  GOTO  440 
NELG=NUMELT/nlq 

IF  ( nlq*NELG . LT . NUMELT )  NELG=NELG+1 


NEL=0 

DO  400  NN=1, NELG 
NMEL=nlq 

IF  (NN.EQ.NELG)  NMEL=NUMELT-nlq* (NELG-1) 

LNS=4 1 

CALL  SCALART  (A (N1 ) , A (N4F) , A (N4A) , A (NT04 ) , A (NT13 ) , A (NT14 ) , 

1  A(LC1T) , SIG, NMEL, NEL,LNS) 

GOTO  (441,  442,  4  00,400,  400,  400,  400,400,479,  479,  47  9,  47  9,  47  9,  47  9, 

F  479,479,479,479,479,479,479,479,479,479,479,479,479,479,479, 
F  479,479,479,479,479,479,479,479,479,479)  K 

HUBER-MISES-HENCKY  -  VERGLEICHSSPANNUNG 

441  DO  45  Jl=l, NMEL 

45  WRITE  (91)  SIG (35+IINT, Jl) 

GOTO  400 

442  DO  46  Jl=l, NMEL 

46  WRITE  (91)  SIG (7+ ( IINT-1 ) *7,  Jl ) 

GOTO  400 

479  DO  47  Jl=l, NMEL 

47  WRITE  (91)  DUMMY 
400  CONTINUE 

440  CONTINUE 

UMSCHREIBEN  AUF  TECPLOT-ELEMENT-SKALARFILES 
REWIND  (91) 

Oeffnen  und  Einlesen  der  TECPLOT-Geometrie-Datei 
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IF  (NDISP  .LT.  1  .AND.  NVELO  . LT .  1)  THEN 
GEOTIT=MOFI (1:9) //' -GEO’ 

ELSE  IF  (NDISP  . GE .  1  .AND.  NVELO  .GE.  1)  THEN 
GEOTIT=MOFI (1:9)//' . KIN ' 

ELSE  IF  (NDISP  .GE.  1  .AND.  NVELO  .LT.  1)  THEN 
GEOTIT=MOFI (1:9)//'. DIS ' 

ELSE  IF  (NDISP  .LT.  1  .AND.  NVELO  . GE .  1)  THEN 
GEOTIT=MOFI (1:9)//' .VEL' 

ENDIF 

OPEN (UNIT=94 , FILE=GEOTIT, FORM= ' FORMATTED ' , STATUS='OLD’ ) 
READ ( 94 , ' (A80 ) ' )  VARCHAR 
WRITE (93, ' (A80) ' )  VARCHAR 
IF (  K  .EQ.  1  )  THEN 

VARCHAR= ' VARIABLES=  "X", "Y", ”Z", "SIGV" ' 

WRITE (93, ' (1X,A29) ')  VARCHAR ( 1 : 2 9 ) 

ELSE  IF  (  K  .EQ.  2  )  THEN 
VARCHAR= ' VARIABLES=  "X", "Y", "Z", "EPSV" ' 

WRITE (93, ' (IX, A29) ' )  VARCHAR ( 1 : 2 9 ) 

ELSE 

VARCHAR (1:29)  =' VARIABLES=  "X”,  "Y",  "Z",  '"//COD//"'' 
WRITE (93, '  ( IX, A2 9 )  ' )  VARCHAR ( 1 : 2 9 ) 

ENDIF 

READ ( 94 , ' (A80 ) ' )  VARCHAR 
READ ( 94 ,  '  ( A8  0 )  ' )  VARCHAR 
WRITE (93, ' (A80) ')  VARCHAR 
VARCHAR  =  ’  ’ 

READ ( 94 , 1 (A80 ) ’ )  VARCHAR 
WRITE (93, ' (A80) ’)  VARCHAR 
ELT  =  VARCHAR (1:27) 

Elementwerte  auf  Knotenwerte  interpolieren 

DO  I  =  1 , NUMNP 
SS ( I )  =  0. 

IVAL(I)  =  0 
ENDDO 
IEL  .=  0 

IF  (NUMELH.GE. 1)  THEN 
DO  222  I  =  1 , NUMELH 
IEL  =  IEL  +  1 
l=nhxpnt ( i ) 

READ (91)  FELD 
DO  201  J2  =  1,8 

NPP  =  ixh ( j2+l, 1) 

IVAL  (NPP)  =  IVAL(NPP)  +  1 

201  SS (NPP)  =  SS (NPP)  +  FELD 

222  CONTINUE 

ENDIF 

IF  (NUMELB.GE. 1)  THEN 
DO  202  I  =  1 , NUMELB 
IEL  =  IEL  +  1 

202  READ (91)  FELD 
ENDIF 

IF  (NUMELS.GE. 1)  THEN 
DO  203  I  =  1 , NUMELS 
IEL  =  IEL  +1 
l=nshpnt (i) 

READ (91)  FELD 
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DO  204  J2  =  1,3 

NPP  =  ixs ( j2  +  l,  1) 

IVAL  (NPP)  =  IVAL(NPP)  +1 

204  SS (NPP)  =  SS (NPP)  +  FELD 
if  (ixs (4,1) .ne. ixs (5, 1) ) then 

NPP  =  ixs (5,1) 

IVAL  (NPP)  =  IVAL (NPP)  +  1 
SS (NPP)  =  SS (NPP)  +  FELD 
endif 

203  CONTINUE 

ENDIF 

IF  (NUMELT.GE. 1)  THEN 
DO  205  I  =  1, NUMELT 
' IEL  =  IEL  +  1 
l=ntxpnt(i) 

READ(91, ' (E12.5) ')  FELD 
•  DO  206  J2  =  1,8 

NPP  =  ixt { j  2+ 1 , 1) 

IVAL  (NPP)  =  IVAL (NPP)  +  1 
206  SS (NPP)  =  SS (NPP)  +  FELD 

205  CONTINUE 
ENDIF 

DO  901  KK  =  1, NUMNP 

IF  (IVAL(KK) .NE.0)  SS (KK)  =  SS(KK)  /  FLOAT (IVAL (KK) ) 
READ (94,*)  XX,  YY,  ZZ 

WRITE (93, ' (4 ( IX, E12 . 5 ) ) ') sngl (XX) ,  sngl (YY) ,  sngl(ZZ), 
1  sngl (SS (KK) ) 

901  CONTINUE 

C 

555  CONTINUE 

READ (94, ' (A80) ' ,END=550)  VARCHAR 
WRITE (93, ' (A80) ' )  VARCHAR 
GOTO  555 
C 

490  CONTINUE 

CLOSE  (UNIT=93) 

550  CLOSE (94) 

C 

500  CONTINUE 
C 

RETURN 

C 

END 
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subroutine  stiffs (x, irect, stf , bh,  ipss, cm,matype, eosp, ieost, numelh, 
lnumels, numelt, nrt, nmmat, ro, zf , thicks,  ethik,  nty,  chrlen, ipst, 

1 jxl, jx7, nsv, nsn, stfvg, thk, sftr, ishlfm, ityptp) 
implicit  double  precision  (a-h, o-z) 
dp 
c 

c  called  by  initlz  to  compute  bulk  modulus  of  each  material  for  sliding 
c  interface  stiffness  determination 
c 

c  call  stiffs  (x, irects (kl) , stfs (k9) , ipsh,b (lcls) , cm,mtype, eosp, 
c  1  ieost, numelh, numels, numelt, nrts, nmmat,  ro,  zfcs,b (ns05) , ethik(k4) , 
c  2  nty, chrlen (n) , b (lclt ) , b (ibinsl )  , b (ibins2) , nsv ( k4 ) , nsn, stf ss, 
c  3  thkslv(k9)  ,b (nlcslv) ,b (nl+nmmat) , ityptp) 
c 


c  ***  Added  Mat  #44  (Elasto-Plastic  with  Void  Effects)  -  McDermott  1999 


if  (mt . eq. 4 1 ) bkm (mx) =cm (mx48ml+21) 
c  Elasto-Plastic  with  Void  Effects  -  McD  '99 

if  (mt . eq. 44 ) bkm (mx) =cm (mx48ml+l ) / (3 . * (1 . -2 . *cm (mx48ml+2 ) ) ) 


end 
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subroutine  stifsn (x, irect, stf , ipsh, ipss, cm,matype, eosp, ieost, 
lnumelh, numels, numelt, nrt, nmmat, ro, zf , thicks, ethik, nty, chrlen, ipst, 
1 jxl, jx7, nsv, nsn, stfvg, thk, sftr, ihlsnd, islsnd, isg2el, stfsnd, 
lthksnd, ishltp, ishlfm) 
implicit  double  precision  (a-h,o-z) 
dp 
c 

c  called  by  initlz  to  compute  bulk  modulus  for  each  material 
c  to  determine  sliding  interface  stiffness  with  materials  in 
c  master  sand  volume 
c 

c  call  stifsn  (x, irectm(k6) , stfm(klO) , ipsh, b (lcls) , cm, mtype, eosp, 
c  1  ieost, numelh, numels, numelt, nrtm, nmmat, ro, zfcm, b (ns 05) , fthik (k5) , 
c  2  nty, chrlen (n) , b (lclt ) , b (ibinsl) ,b (ibins2 ) ,msr (k5) , nmn, stfsm, 
c  3  thkmsr (klO) ,b (nlcmsr)  ,  ihlsnd (kd3)  ,  islsnd (kd4 ) , 
c  4  isg2el (kd7 )  ,  stfsnd (kdll) ,  thksnd (kdl2 ) , ishltp (kd5 ) , b (nl+nmmat ) ) 
c 

c  slave  sand  volume 
c 

c  call  stifsn  (x, irects ( kl) , stfs (k9) , ipsh, b (lcls) , cm, mtype, eosp, 
c  1  ieost, numelh, numels, numelt, nrts, nmmat, ro, zfcs, b (ns05) , ethik (k4 ) , 
c  2  nty, chrlen (n) , b (lclt) , b (ibinsl)  , b (ibins2 ) , nsv (k4 ) , nsn, stf ss, 
c  3  thkslv (k9) , b (nlcslv) , ihlsnd (kd3) , islsnd (kd4 ) , 

c  4  isg2el (kd7 )  ,  stfsnd (kdll) ,  thksnd (kdl2 ) , ishltp (kd5 ) , b (nl+nmmat ) ) 
c 

c  ***  Added  Elasto-Plastic  with  Void  Effects  (#44)  -  McDermott  1999 
c 


if  (mt.eq.39)  bkm (mx) =cm (mx48ml+l) / (3 . * ( 1 . -2 . *cm (mx48ml+2 ) ) ) 
^  *************************************** 
c  Elasto-Plastic  with  Void  Effects  -  McD  '99 

if  (mt.eq.44)  bkm (mx) =cm (mx48ml+l) / (3 . * (1 . -2 . *cm (mx48ml+2 ) ) ) 

q  'Ic'k'kJe'k’k'k'k’k’k’k’krk'k'ie'k'k'k'jr'k'k’ie’kie'k’kJe'it'k’k'ie'kir'k’k'k'k'k'k’k’k'k'k’kJe’ir-k’k'k-k-k'k 


end 
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SUBROUTINE  TEC_TEN  (A,  nhxpnt, nshpnt, ntxpnt, ixh, ixs, ixt, ss, ival  ) 
C 

C  WRITE  SCALAR  PLOT  FILES  ( TECPLOT-FORMAT )  ONLY  STRESS-  AND  STRAIN- 
C  TENSOR 

C  REIHENFOLGE  WICHTIG  ! ! ! 

C  1.)  VOLUMENELEMENTE 

C  2.)  BALKENELEMENTE  (werden  von  TECPLOT 

nicht 

C  unterstuetzt) 

C  3 . )  SCHALENELEMENTE 

C  4 . )  DICKE  SCHALENELEMENTE 


c 

c  Corrected  bug  in  some  of  the  scratchfile  writes  -  they  must  be 
c  the  same  precision  and  the  variable  used  for  reads  (ie  double) 
c  (Did  not  mark  changes,  since  they  occur  throughout  subroutine) 
c  -  McDermott,  '99 

£********■*.*.*•*■*•  •k-k'k'k'k'k-k'k-k'ie  *★*************★*★****★*****★★**★*★***■*■■*■★★'*■•*•'*' 

implicit  double  precision  (a-h,o-z) 
dp 

include  'nlqpar.inc' 

COMMON/BKOO/NUMNP, NUMPC , NUMLP , NEQ , NDOF,  NLCUR,  NUMCL, NUMVC, 

1  .  NDTPTS, NELMD, NMMAT, NUMELH, NUMELB,  NUMELS, NUMELT, NUMDP, 

2  GRVITY, IDIRGV, NODSPC, NSPCOR 

cfu 

common/bk03/endtim,prtc,pltc, ndthl, nsthl, nstsl,  nstbl,  nsttl,mkthf 
common/bk03/endtim, prtc, pltc, ngthl, ndthl, nsthl, nstsl, nstbl, 

1  nsttl, ncpll,mkthf 

COMMON/BK04 /PRTOUT, PLTOUT, DT20LD, SLSFAC, TSSFAC, I HYDRO, 

Cfu  1  NDTH, NMST, NSTH, NSTS,  NSTB,  NSTT,  IKEDIT 

1  ngth,  ndth, nmst, nsth, nsts, nstb, nstt, ncpl,  ikedit 
COMMON /BKO 5/ 

1  NH01 , NH02 , NH03, NH04 , NH05, NH06, NH07 , NH08 ,  NH09,  NH10, 

2  NB01, NB02 , NB03, NB04 , NB05, NB06, NB07 , NB08,  NB09,  NB10, 

3  NS 01,  NS 02 , NS03, NS04 , NS05 , NS 0 6, NS 07 , NS08 ,  NS09,  NS10 , 

4  NT01 ,  NT02 , NT03 , NT04 , NT05 , NT06, NT07 , NT08 , NT09, NT10 
REAL *8  HEAD 

VAX750 

common/bk06/time (2,8), head (12) , idmmy, iadd, ifil,maxsiz, ncycle 
common/bk07/nl, n2, n3, n4 , n5, n6, n7, n8 , n9, nlO, nil, nl2, nl3, nl4 , nl5, 

1  nl6,  nl7,  nl8 , nl9, n20, n21, n22, n23, n24 , n25, n26, n27, n28 , n29, n30, n31, 

2  n32,n33,n34,n35,n36,n37,n38,n39,n40,n41,n42,n43,n44,n45, 

3  n46, n47, n48, n49, n50, n51, n52, n53, n54, n55, n56, n57, n58, n59, n60, n61, 

4  n62, n63, n64, n65, n66, n67, n68, n69, n70, n71,  n72,  n73,  n74 ,  n75,  n7  6,  n77, 

5  n78, n79, n80, n81, n82, n83, n84, locend, iname, lendf 
common/bk08/n4a, n4b, n4c, n4d, n4e, n4f , n4g, n4h,  n7a, n7b, n7c, n7d, n7e, 

1  nusir,mpusr,mpubr 

COMMON/BK13/LCO , LC1H, LC1B, LC1S, LC1T, LC2, LC3, LC4 , LC5, LC6, LC7 , LC9, 

1  ■  LC10, LC11, LC12, LC13, LC14, LC15, LC16, LC17, LC18, LBO, LB1, LB2, 

2  LC7A, LC7B  , 

COMMON/BK2 0 /NUMS V, JU, JV, NRTM, NRTS, NMN,  NSN,  NTY,  NST,  MST,  NOCO 
COMMON / BK2 8 / S UMMS S , XKE ,  X PE ,  T T 
COMMON/AUX14/SIG (49, nlq) 

COMMON/ SHLOPT/ISTRN, ISTUPD, IBELYT, MITER 
common/sorter/nnc, lczc, 

6  ns 11, nsl2, nsl3, nsl4, nsl5, nsl6, nsl7, 

&  nhll,nhl2,nhl3,nhl4,nhl5,nhl6,nhl7, 

&  ntll, ntl2, ntl3, ntl4, ntl5, ntl6, ntl7, 

&  nbll,nbl2,nbl3,nbl4,nbl5,nbl6,nbl7 

COMMON / I NKT H /  INCHIS,  NPOST,  NDISP,  NVELO,  NCYREM, 

1  NSTRESS,  NSTRAIN 
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CHARACTER* 8  DATU,VS 
CHARACTER* 60  SBTEXT(20) 

COMMON /VSNUM/ VS, DATU 

CHARACTER  MOFI*13, COD*3, C0D1*6,  GEOTIT*13 
CHARACTER  VARCHAR*84,  ELT*27 
C 

DIMENSION  A(*) 

DIMENSION  VLSTRAI (7,nlq)  ,  EMAIN ( 6, nlq) 

DIMENSION  SS  (*) ,  FELD (14),  VAL1(7),  IVAL(*) 
dimension  ixh ( 9, *) , ixs (5, *) ,  ixt ( 9,  *) 
dimension  nhxpnt ( * ) , nshpnt ( * )  , ntxpnt ( * ) 

C 

c 

WRITE  (COD1, ' (16) ' )  NCYCLE 
C 

IF  (NCYCLE.LT. 100000)  COD1 (1: 1)=' O' 

IF  (NCYCLE.LT. 10000)  COD1 (2 : 2 ) = ' 0 ' 

IF  (NCYCLE.LT. 1000)  COD1 (3:3)=’ O’ 

IF  (NCYCLE.LT. 100)  COD1 (4 : 4 ) =' 0 ' 

IF  (NCYCLE.LT. 10)  COD1 (5 : 5)=' O' 

C 

MOFI (1:3)  =  'TEC' 

MOFI (4:9)  =  COD1 
DUMMY=0 . 

C 

IF  (NSTRESS  .EQ.  1)  THEN 
C 

COD  =  ' Sij ’ 

MOFI (10:13)=' . '//COD 
C 

OPEN  (UNIT=91, POSITION= ' REWIND ' , 

1  STATUS= ' SCRATCH ' , FORM= ' UNFORMATTED ' ) 

OPEN  (UNIT=93, STATUS= ' UNKNOWN ' , FILE=MOFI,  FORM= ' FORMATTED ' ) 

HEXAHEDRONS 

IF  (  NUMELH  .EQ.  0  )  GOTO  140 
NELG=NUMELH/nlq 

IF  (nlq*NELG.LT. NUMELH)  NELG=NELG+1 
NEL=0 

DO  100  NN=1, NELG 
NMEL=nlq 

IF  (NN.EQ.NELG)  NMEL=NUMELH-nlq* (NELG-1) 

CALL  SCALARH  (A (LC1H) , A (LC15 ) , A (N1 ) , A (NH13 ) , A (NH14 ) , A (NH04 ) , 
1  VLSTRAI,  NEL,NMEL) 

HUBER-MISES-HENCKY  -  VERGLEICHSSPANNUNG  UND 
SPANNUNGEN  IM  GLOBALEN  KOORD.-SYST. 

SIG-XX,  SIG-YY,  SIG-ZZ,  SIG-XY,  SIG-YZ,  SIG-ZX 

DO  Jl=l, NMEL 

WRITE  (91)  SIG(8,J1) , SIG ( 1 , J1 )  ,SIG(2,J1)  ,  SIG ( 3 ,  J1 )  , 

1  SIG ( 4 , J1 ) ,SIG(6,J1) ,SIG(5,J1) , 

2  SIG  (8,  Jl)  ,  SIG  (1,  Jl)  ,  SIG  (2,  Jl)  ,  SIG  (3,  Jl)  , 

3  SIG(4, Jl) ,SIG(6, Jl) ,SIG(5, Jl) 

ENDDO 

C 

100  CONTINUE 
C 
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C  BEAM  ELEMENTS 
C 

140  IF  (  NUMELB  .EQ.  0  )  GOTO  240 
NELG=NUMELB/nlq 

IF  (nlq*NELG.LT. NUMELB)  NELG=NELG+1 
C 

NEL=0 

DO  300  NN=1, NELG 
NMEL=nlq 

IF  (NN.EQ.NELG)  NMEL=NUMELB-nlq* (NELG-1) 

C  LNS=7 

C  CALL  SCALARB  (A (NB04 ) , A (NB13) ,  SIG,  NMEL,  NEL,  LNS ) 

DO  Jl=l, NMEL 

WRITE  (91)  (  DUMMY,  J14=l,14  ) 

ENDDO 

300  CONTINUE 
C 

C  SHELL  ELEMENTS 
C 

240  IF  (  NUMELS  .EQ.  0  )  GOTO  340 
NELG=NUMELS/nlq 

IF  (nlq*NELG.LT. NUMELS)  NELG=NELG+1 
C 

NEL=0 

DO  200  NN=1 , NELG 
NMEL=nlq 

IF  (NN.EQ.NELG)  NMEL=NUMELS-nlq* (NELG-1 ) 

LNS=4  9 

CALL  SCALARS (A (N1 ) ,A(N4F) ,A(LC11) ,A(N4A) ,A(LC1S) ,A(NS05) ,A(NS06) 
F  , A (NS03 ) ,A(NS01) ,SIG, LNS, A (NS 07)  ,A(N4H)  ,MPUSR, 

F  A (Nl+NMMAT) ,A(NSTSL) , A(NS13)  ,  A (NS14 )  ,  NEL, NMEL, 

F  A (NS02 ) , EMAIN) 

C 

C  HUBER-MISES-HENCKY  -  VERGLEICHSSPANNUNG  UND 
C  SPANNUNGEN  IM  GLOBALEN  KOORD.-SYST. 

C  SIG-XX,  SIG-YY,  SIG-ZZ,  SIG-XY,  SIG-YZ,  SIG-ZX 
C 

DO  Jl=l, NMEL 

WRITE  (91)  SIG(16,J1),SIG(9,J1),SIG(  10,'J1  ),SIG(11,J1), 

1  SIG  (12,  Jl)  ,  SIG  (14,  Jl)  ,  SIG  (13,  Jl)  ,  SIG  (24,  Jl)  , 

2  SIG (17, J1),SIG(18, Jl) , SIG (19, Jl) , SIG (20, Jl) , 

3  SIG(22, Jl) ,SIG(21, Jl) 

ENDDO 

200  CONTINUE 
C 

C  THICK  SHELLS 
C 

340  IF  (NUMELT . EQ . 0 )  GOTO  440 
NELG=NUMELT/nlq 

IF  (nlq*NELG.LT. NUMELT)  NELG=NELG+1 
C 

NEL=0 

DO  400  NN=1 , NELG 
NMEL=nlq 

IF  (NN.EQ.NELG)  NMEL=NUMELT-nlq* (NELG-1 ) 

LNS=41  ' 

CALL  SCALART  (A (N1 ) , A (N4F) , A (N4A) , A (NT04 )  ,  A (NT13 )  ,  A (NT14 ) , 

1  A(LC1T) , SIG, NMEL, NEL, LNS) 

C 

C  HUBER-MISES-HENCKY  -  VERGLEICHSSPANNUNG  UND 
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C  SPANNUNGEN  IM  GLOBALEN  KOORD.-SYST. 

C  SIG-XX,  SIG-YY,  SIG-ZZ,  SIG-XY,  SIG-YZ,  SIG-ZX 
C 

■  DO  J1=1,NMEL 

WRITE  (91)  SIG(37, Jl) ,SIG(8, Jl) ,SIG(9, Jl) ,SIG(10, Jl) , 

1  SIG(11,  Jl)  ,SIG(13,  Jl)  ,SIG(12,  Jl)  ,  SIG(38,  Jl)  ,.SIG(15,  Jl)  , 

2  SIG(16,  Jl)  ,SIG(17,  Jl)  ,SIG(18, Jl) ,SIG(20, Jl) , 

3  SIG ( 19, Jl ) 

ENDDO 

C 

400  CONTINUE 
440  CfONTINUE 

UMSCHREIBEN  AUF  TECPLOT-ELEMENT-SKALARFILES 
REWIND  (91) 

Oeffnen  und  Einlesen  der  TECPLOT-Geometrie-Datei 

IF  (NDISP  .LT.  1  .AND.  NVELO  .LT.  1)  THEN 
GEOTIT=MOFI (1:9)//'. GEO ' 

ELSE  IF  (NDISP  . GE .  1  .AND.  NVELO  .GE.  1)  THEN 
GEOTIT=MOFI (1:9)//' .KIN' 

ELSE  IF  (NDISP  .GE.  1  .AND.  NVELO  .LT.  1)  THEN 
GEOTIT=MOFI (1:9)//' .DIS’ 

ELSE  IF  (NDISP  . LT .  1  .AND.  NVELO  .GE.  1)  THEN 
GEOTIT=MOFI (1:9)//'. VEL ' 

ENDIF 

OPEN ( UNIT=94 , FILE=GEOTIT, FORM= ' FORMATTED ' , STATUS= ' OLD ' ) 

READ ( 94 , ' (A80 ) ’ )  VARCHAR 
WRITE (93, ' (A80) ' )  VARCHAR 

VARCHAR= ' VARIABLES=  "X", "Y", "Z", "SIGV", "SIG-XX", "SIG-YY"'// 

1  ',  "SIG-ZZ",  "SIG-XY", "SIG-YZ", "SIG-ZX"' 

WRITE (93, ' (IX, A84) ' )  VARCHAR ( 1 : 8 4 ) 

READ ( 94 , ' (A80 ) ' )  VARCHAR 
READ ( 94 , ' (A80 ) ' )  VARCHAR 
WRITE (93, ' (A80) ' )  VARCHAR 
VARCHAR  =  '  ' 

READ ( 94 , '  (A8 0 )  ' )  VARCHAR 
WRITE (93, ' (A80) ' )  VARCHAR 
ELT  =  VARCHAR (1:27) 

Elementwerte  auf  Knotenwerte  interpolieren 


Spannungstensor 

DO  880  L  =  1,2 

DO  800  K  =  (L-l ) *7+1  , (L-l ) *7+7 
REWIND (91) 

I  EL  =  0 

DO  I  =  1 , NUMNP 
SS(I)  =  0. 

IVAL(I)  =  0 
ENDDO 

IF  (NUMELH . GE . 1 )  THEN 
DO  600  I  =  1, NUMELH 
IEL  =  IEL  +  1 
ll=nhxpnt (i) 

READ ( 91 )  (FELD(II) ,11=1,14) 
DO  700  J2  =  1,8 
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NPP  =  ixh ( j  2+1 , 11) 

IVAL  (NPP)  =  IVAL (NPP)  +  1 
700  SS (NPP)  =  SS (NPP)  +  FELD (K) 

600  CONTINUE 
ENDIF 

C 

IF  (NUMELB.GE. 1)  THEN 
DO  601  I  =  1 , NUMELB 
IEL  =  I EL  +  1  . 

601  READ (91)  FELD ( 1 ) 

ENDIF 

C 

.  IF  (NUMELS.GE.l)  THEN 
DO  602  I  =  1 , NUMELS 
IEL  =  IEL  +  1 
ll=nshpnt(i) 

READ ( 91)  (FELD(II) , 11=1, 14) 

DO  702  J2  =  1,3 

NPP  =  ixs(j2+l,ll) 

IVAL  (NPP)  =  IVAL (NPP)  +  1 

702  SS  (NPP)  =  SS (NPP)  +  FELD (K) 
if  .  (ixs (4,11) .ne. ixs (5, 11) ) then 

NPP  =  ixs (5, 11) 

IVAL  (NPP)  =  IVAL (NPP)  +  1 
SS (NPP)  =  SS (NPP)  +  FELD (K) 
endif 

602  CONTINUE 
ENDIF 

C 

IF  (NUMELT.GE. 1)  THEN 
DO  603  I  =  1 , NUMELT 
IEL  =  IEL  +  1 
ll=ntxpnt (i) 

READ (91)  (FELD (II) , 11=1, 14) 

DO  703  J2  =  1,8 

NPP  =  ixt ( j2+l, 11) 

IVAL  (NPP)  =  IVAL (NPP)  +  1 

703  SS (NPP)  =  SS (NPP)  +  FELD (K) 

603  CONTINUE 
'  ENDIF  . 


C 

IOP  =  23+K- (L-l ) *7 

OPEN (UNIT=IOP, STATUS= ’ SCRATCH ' , FORM= ' UNFORMATTED ' ) 

DO  900  KK  =  1, NUMNP 

IF  (IVAL(KK) -NE.0)  SS (KK)  =  SS (KK)  /  FLOAT ( IVAL (KK) ) 
900  WRITE (IOP)  SS (KK) 

800  CONTINUE 

C 

DO  910  1=1,7 
IOP  =  23+1 
910  REWIND (IOP) 

C 

IF  (L.EQ.2)  THEN 

VARCHAR (1:50)  =ELT/ / '  D= ( 1 , 2 , 3 , FECONNECT ) 

WRITE (93, ' (A50) ’ )  VARCHAR 
DO  850  I  =  1, NUMNP 
DO  860  II  =  1,7 
IOP=23+II 

860  READ (IOP)  VALl(II) 

850  WRITE (93,  '  (7(1X,E12.5))  ')  (sngl (VAL1 (IK) ) , IK=1,  7) 
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GOTO  999 
ENDIF 
C 

DO  810  I  =  1 , NUMNP 
READ (94,*)  XX,  YY,  ZZ 
DO  820  II  =  1,7 
IOP=23+II 

READ ( IOP)  VALl(II) 

820  CONTINUE 

WRITE (93, '  (10(1X,E12.5) )  ') XX,  YY,  ZZ,  (VAL1 (IK) , IK-1, 7) 

810  CONTINUE 
C 

DO  830  I  =  1,7 
IOP  =  23+1 
830  CLOSE (IOP) 

C 

888  CONTINUE 

READ ( 9 4 ,  '  ( A8 0 )  ' , END=8  8  0 )  VARCHAR 
ICOL  =  INDEX (VARCHAR, ' D= ' ) 

IF  (ICOL.GT.O)  VARCHAR ( I COL : I COL+ 2 4 )  =  ' D= ( 1, 2, 3, 4 , 5, 6, 7, 8, 9, 10 ) 
WRITE (93, ' (A80) ' )  VARCHAR 
GOTO  888 
880  CONTINUE  , 

C 

CLOSE  (93) 

999  CLOSE  (94) 

C 

ENDIF 

C 

IF  (NSTRAIN  .EQ.  1  )  THEN 
C 

COD  =  1 Ei j  ' 

MOFI (10:13)=' . '//COD 
C 

OPEN  (UNIT=91, POSITIONS  REWIND', 

1  STATUS= ' SCRATCH ' , FORM= ' UNFORMATTED ' ) 

OPEN  (UNIT=93, STATUS= ' UNKNOWN ' , FILE=MOFI, FORM=' FORMATTED' ) 

HEXAHEDRONS 

IF  (  NUMELH  .EQ.  0  )  GOTO  1140 
NELG=NUMELH/nlq 

IF  (nlq*NELG.LT. NUMELH)  NELG=NELG+1 


NEL=0 

DO  1100  NN=1 , NELG 
NMEL=nlq 

IF  (NN.EQ.NELG)  NMEL=NUMELH-nlq* (NELG-1 ) 

CALL  SCALARH  (A (LC1H) , A (LC15) , A (N1 ) , A (NH13)  ,  A (NH14 ) , A (NH04 ) , 
.  1  VLSTRAI , NEL, NMEL ) 

PLAST.  VERGLEICHSDEHNUNG  UND 
DEHNUNGEN  IM  GLOBALEN  KOORD.-SYST. 

EPS-XX,  EPS-YY,  EPS-ZZ,  EPS-XY,  EPS-YZ,  EPS-XZ, 


DO  Jl=l , NMEL 

WRITE  (91)  SIG (7, Jl) , VLSTRAI (1,J1)  ,  VLSTRAI (2,  Jl) , VLSTRAI (3, Jl) , 

1  VLSTRAI (4, Jl) , VLSTRAI (6, Jl) , VLSTRAI (5,  Jl) ,  . 

2  SIG  (7,  Jl)  ,  VLSTRAI  (1,  Jl)  ,  VLSTRAI  (2,  Jl)  ,  VLSTRAI  (3,  Jl)  , 

3  VLSTRAI  (4,  Jl)  ,  VLSTRAI  (  6,  Jl )  ,  VLSTRAI  (5,  Jl) 
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ENDDO 

1100  CONTINUE 
C 

C  BEAM  ELEMENTS 
C 

1140  IF  {  NUMELB  .EQ..  0  )  GOTO  1240 
NELG=NUMELB/nlq 

IF  (rilq*NELG.LT. NUMELB)  NELG=NELG+1  • . 

C 

NEL=0 

DO  1300  NN=1, NELG 
NMEL=nlq 

IF  (NN.EQ.NELG)  NMEL=NUMELB-nlq* (NELG-1) 

C  LNS=7 

C  CALL  SCALARB  (A (NB04 ) , A (NB13) , SIG, NMEL, NEL, LNS ) 

DO  Jl=l, NMEL 

WRITE  (91)  (  DUMMY,  J14=l,14  ) 

ENDDO 

1300  CONTINUE 
C 

C  SHELL  ELEMENTS 
C 

1240  IF  (  NUMELS  .EQ.  0  )  GOTO  1340 
NELG=NUMELS/nlq 

IF  (nlq*NELG.LT. NUMELS)  NELG=NELG+1 
C 

NEL=0 

DO  1350  NN=1, NELG 
NMEL=nlq 

IF  (NN.EQ.NELG)  NMEL=NUMELS-nlq* (NELG-1) 

LNS=4  9 

CALL  SCALARS  (A(N1) ,A(N4F) ,A(LC11) ,A(N4A) ,A(LC1S) ,A(NS05)  ,A(NS06) 
F  , A (NS03 ) , A (NS01 ) , SIG, LNS , A (NS07 ) ,A(N4H)  ,MPUSR, 

F  A (Nl+NMMAT) , A (NSTSL) , A (NS13 ) , A (NS14 )  ,  NEL,  NMEL, 

F  A (NS 02 ) , EMAIN) 

C 

C  PLAST.  VERGLEICHSDEHNUNG  UND 

C  VERZERRUNGEN  AN  DER  UNTER-  UND  OBERSEITE  DER  PLATTE 
C  ( IINT=1 :  UNTERSEITE,  IINT=2:  OBERSEITE)  IM  GLOBALEN  KOORD.-SYST. 

C  EPS-XX,  EPS-YY,  EPS-ZZ,  EPS-XY,  EPS-YZ,  EPS-XZ, 

C 

DO  Jl=l , NMEL 

WRITE  (91)  SIG ( 15, J1 ) ,SIG(36,J1) , SIG ( 37 , Jl ) , SIG (38 , J1 )  , 

1  SIG  (39,  Jl)  ,  SIG  (41,  Jl)  ,  SIG  (40,  Jl)  ,  SIG  (23,  Jl)  , 

2  SIG (42, Jl) , SIG (43, Jl) , SIG ( 44 , Jl ) , SIG ( 45, Jl ) , 

3  SIG(47, Jl) ,SIG(46, Jl) 

ENDDO 

1350  CONTINUE 
C 

C  THICK  SHELLS 
C 

1340  IF  (NUMELT . EQ . 0 )  GOTO  1540 
NELG=NUMELT / nlq 

IF  (nlq*NELG.LT. NUMELT)  NELG=NELG+1 
C 

NEL=0 

DO  1500  NN=1 , NELG 
NMEL=nlq 

IF  (NN.EQ.NELG)  NMEL=NUMELT-nlq* (NELG-1 ) 

LNS=41 


152 


ooooo  onooon 


,  CALL  SCALART  (A (N1 ) , A (N4F) , A (N4A) , A (NT04 )  ,  A (NT13 )  ,  A (NT14 ) , 
1  A(LC1T) , SIG, NMEL, NEL, LNS) 

DO  Jl=l, NMEL 

WRITE  (91)  SIG ( 14 , J1 ) ,  (DUMMY,  1=1,6), 

1  SIG (21, J1 ) ,  (DUMMY,  1=1,6) 

ENDDO 

1500  CONTINUE 
1540  CONTINUE 

UMSCHREIBEN  AUF  TECPLOT-ELEMENT-SKALARFILES 
REWIND  (91) 


Oeffnen  und  Einlesen  der  TECPLOT-Geometrie-Datei 

IF  (NDISP  .LT.  1  .AND.  NVELO  .LT.  1)  THEN 
GEOTIT=MOFI (1:9)//' . GEO' 

ELSE  IF  (NDISP  .GE.  1  .AND.  NVELO  .GE.  1)  THEN 
GEOTIT=MOFI (1:9)//' .KIN' 

ELSE  IF  (NDISP  .GE.  1  .AND.  NVELO  .LT.  1)  THEN 
GEOTIT=MOFI (1:9)//'. DIS ' 

ELSE  IF  (NDISP  .LT.  1  .AND.  NVELO  .GE.  1)  THEN 
GEOTIT=MOFI (1:9)//' .VEL" 

ENDIF 

OPEN ( UNIT=94 , FILE=GEOTIT, FORM= ' FORMATTED ' ,  STATUS= ' OLD ' ) 

READ ( 9  4 ,  '  ( A8  0 )  ' )  VARCHAR 
WRITE (93, ' (A80) ' )  VARCHAR 

VARCHAR= ' VARIABLES=  "X", "Y", "Z", "EPSV", "E-XX", "E-YY", "E-ZZ" ' // 
1  ' , "E-XY", "E-YZ", "E-ZX" ' 

WRITE ( 93,  '  ( IX, A72 ) ' )  VARCHAR (1:72) 

READ ( 94 , ' (A80 ) ’ )  VARCHAR 
READ ( 94 , '  (A8  0 )  ’ )  VARCHAR 
WRITE (93, ' (A80) ' )  VARCHAR 
VARCHAR  =  '  1 
READ ( 94 ,  '  ( A8  0 )  ' )  VARCHAR 
WRITE (93, ' (A80) ’ )  VARCHAR 
ELT  =  VARCHAR (1:27) 


Elementwerte  auf  Knotenwerte  interpolieren 


Dehnungstensor 

DO  1880  L  =  1,2 

DO  1800  K  =  (L-l ) *7+1  , (L-l ) *7+7 
REWIND (91) 

I EL  =  0  . 

DO  I  =  1 , NUMNP 
SS(I)  =  0. 

IVAL(I)  =  0 
ENDDO 

IF  (NUMELH . GE . 1 )  THEN 
DO  1600  I  =  1, NUMELH 
IEL  =  IEL  +  1 
ll=nhxpnt (i) 

READ (91)  (FELD (II) ,11=1,14) 

DO  1700  J2  =  1,8 

NPP  =  ixh ( j2+l, 11) 

IVAL  (NPP)  =  IVAL(NPP)  +  1 
1700  SS (NPP)  =  SS (NPP)  +  FELD (K) 
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1600 
C  • 

1601 

C 


1702 

1602 

C 


1703 

1603 

C 

1900 

1800 

C 


1910 

C 


1860 

1850 


CONTINUE 

ENDIF 

IF  (NUMELB.GE.l)  THEN 
DO  1601  I  =  1 , NUMELB 
IEL  =  IEL  +  1 
READ (91)  FELD ( 1 ) 

ENDIF 

IF  (NUMELS.GE.l)  THEN 
DO  1602  I  =  1 , NUMELS 
IEL  =  IEL  +  1 
ll=nshpnt (i) 

READ (91)  (FELD (II), 11=1, 14) 

DO  1702  J2  =  1,3 

NPP  =  ixs ( j  2+1, 11) 

IVAL  (NPP)  =  IVAL(NPP)  +  1 
SS (NPP)  =  SS (NPP)  +  FELD (K) 
if  (ixs (4, 11) .ne . ixs (5, 11) ) then 
NPP  =  ixs (5,11) 

IVAL  (NPP)  =  IVAL (NPP)  +  1 
SS (NPP)  =  SS (NPP)  +  FELD (K) 
endif 
CONTINUE 
ENDIF 

IF  (NUMELT.GE. 1)  THEN 
DO  1603  I  =  1 , NUMELT 
IEL  =  IEL  +  1 
ll=ntxpnt(i) 

READ (91)  (FELD(II) , 11=1, 14) 

DO  1703  J2  =  1,8 

NPP  =  ixt ( j2+l, 11) 

IVAL  (NPP)  =  IVAL (NPP)  +  1 
SS (NPP)  =  SS (NPP)  +  FELD (K) 

CONTINUE 

ENDIF 

IOP  =  23+K- (L-l ) *7 

OPEN (UNIT=IOP, POSITION= ' REWIND ' , 

STATUS= ' SCRATCH ' , FORM= ' UNFORMATTED ' ) 

DO  1900  KK  =  1 , NUMNP 

IF  (IVAL(KK) .NE.0)  SS (KK)  =  SS(KK)  /  FLOAT ( IVAL (KK) ) 
WRITE (IOP)  .  SS (KK) 

CONTINUE 

DO  1910  1=1,7 
IOP  =  23+1 
REWIND (IOP) 

IF  (L.EQ.2)  THEN 

VARCHAR (1:50)  =ELT/ / '  D= (1, 2, 3, FECONNECT) 

WRITE (93, ' (A50) ' )  VARCHAR 
DO  1850  I  =  1, NUMNP 
DO  1860  II  =  1,7 
IOP=23+II 

READ (IOP)  VALl(II) 

WRITE (93, ' (7 (IX, E12 . 5) ) ' )  (VAL1 ( IK) , IK=1 , 7 ) 

GOTO  2550 
ENDIF 
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c 

DO  1810  I  =  1, NUMNP 
READ (94,*)  XX,  YY,  ZZ 
DO  1820  II  =1,7 
IOP=23+II 
READ ( IOP)  VALl(II) 

1820  CONTINUE 

WRITE (93,  '  (10(1X,E12.5) )  ') XX,  YY,  ZZ,  (VAL1 (IK)  ,  IK=1,  7) 

1810  CONTINUE 
C 

DO  1830  I  =  1,7 
IOP  =  23+1 
1830  CLOSE (IOP) 

C 

1888  CONTINUE 

READ  (94,  '  (A80)  \END=1880)  VARCHAR 
ICOL  =  INDEX (VARCHAR, 'D=' ) 

IF  (ICOL.GT.O)  VARCHAR (ICOL: ICOL+24)  =  ' D= ( 1, 2, 3, 4 , 5, 6, 7 , 8 , 9, 10 )  ' 
WRITE (93, ' (A80) ' )  VARCHAR 
GOTO  1888 
1880  CONTINUE 
C 

CLOSE  (93) 

2550  CLOSE  (94) 

ENDIF 

C 

RETURN 

END 
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SUBROUTINE  TECPLOT  (  V,  X,  XO, nhxpnt, nshpnt, ntxpnt, ixh, ixs, ixt) 
C 

C  This  SBR  writes  for  every  flagged  cycle  the  actual  node 
configuration 

C  of  the  whole  structure  in  TECPLOT-format  (ASCII) 
c 

c  Added  global  variable  to  keep  track  of  number  of  files  (TECPLOT 
zones) , 

c  and  attach  cycle  and  time  text  to  the  zone,  removed  a  couple 
associated 

c  character  variables 

c  Not  complete,  since  it  doesn't  work  for  files  where  there  are 
c  two  zones  in  one  file  (Like  stress  and  strain)  -McDermott  '99 

Q* ******************************************************************* 

implicit  double  precision  (a-h,o-z) 
dp 

REAL *8  HEAD 

VAX750 

COMMON/BKOO/NUMNP, NUMPC, NUMLP, NEQ, NDOF, NLCUR, NUMCL, NUMVC, 

1  NDTPTS , NELMD, NMMAT, NUMELH, NUMELB, NUMELS, NUMELT, NUMDP, 

2  GRVITY, IDIRGV, NODSPC, NSPCOR 

common/bk06/time  (2,8),  head  ( 12)  ,  idmmy,  iadd,  i.fil,maxsiz,  ncycle 
COMMON/BK28/SUMMSS, XKE,  XPE,  TT 

COMMON/INKTH/  INCHIS,  NPOST,  NDISP,  NVELO,  NCYREM, 

1  NSTRESS,  NSTRAIN 

COMMON/ELTYP/  NEV 

c  ***  New  Variable  for  current  TECPLOT  zone  number  -  McD 
common/TEC/  izone 
c  integer  save  izone 

CHARACTER* 8  DATU 
COMMON/VSNUM/VS, DATU 
CHARACTER* 2 4  DISCHAR  ,  XYCHAR 
CHARACTER* 18  VELCHAR 
CHARACTER* 13  MOFI 
CHARACTER* 6  COD 

CHARACTER  VARCHAR*66,  VS* 8,  DAT *9 
character*66  varchal 
c  character* 66  TEXT 

DIMENSION  X( 3, *) ,  X0(3,*),  V (3, * ) 

dimension  ixh ( 9, *) , ixs ( 5, * ) , ixt ( 9, * ) 
dimension  nhxpnt ( * ) , nshpnt ( * ) , ntxpnt ( * ) 

C 

DATA  XYCHAR  / ' VARIABLES=  "X",  "Y",  "Z"'/ 

DATA  VELCHAR  /',  "VX",  "VY",  "VZ"'/ 

DATA  DISCHAR  /',  "DISX",  "DISY",  "DISZ"’/ 

C 

c  ***  Initialize  izone  of  first  cycle 
if  (ncycle . le . 1)  izone  =  0 
izone  =  izone  +  1 

WRITE  (COD, '(16)')  NCYCLE 
IF  (NCYCLE. LT. 100000)  COD(1:1)='0' 

IF  (NCYCLE. LT. 10000)  COD{2:2)='0' 

IF  (NCYCLE. LT. 1000)  COD(3:3)='0' 

IF  (NCYCLE.LT. 100)  COD (4: 4)=' O' 

IF  (NCYCLE.LT. 10)  COD(5:5)='0' 

MOFI (1:3)  =  'TEC' 

MOFI (4: 9)  =  COD 

IF  (NDISP  .LT.  1  .AND.  NVELO  . LT .  1)  THEN 
MOFI (10:13)=’ .GEO’ 
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IDUP 

=  1 

ELSE  IF 

(NDISP 

.GE.  1 

.AND. 

NVELO 

.GE. 

1) 

THEN 

MOFI 

(10:13)= 

'  .KIN' 

IDUP 

=  3' 

ELSE  IF 

(NDISP  , 

.GE.  1 

.AND. 

NVELO 

.LT. 

1) 

THEN 

MOFI  I 

(10:13)=' 

'  .DIS' 

IDUP 

=  2 

ELSE  IF 

(NDISP  , 

.  LT .  1 

.AND. 

NVELO 

.GE. 

1) 

THEN 

MOFI  1 

(10:13)=’ 

'  .VEL' 

IDUP  =  2 
ENDIF 
C 

CALL  DATE (DAT) 

C 

C  Oeffnen  und  schreiben  der  TECPLOT  Datei 

C 

C 

NKN=NUMNP 
IZO  =  0 
KHILF  =  0 
VARCHAR  =  XYCHAR 
IC  =  24 
C 

OPEN  (UNIT=31, STATUS=' UNKNOWN' , FILE=MOFI (1 : 13) , FORM= ' FORMATTED ' ) 
C 

IF  (  NDISP  .GE.  1  )  THEN 

VARCHAR  =  XYCHAR/ /DISCHAR 
IC  =  48 

ENDIF 

IF  (  NVELO  .GE.  1  )  then 

VARCHA1  =  VARCHAR (1 : IC) //VELCHAR 
varchar  =varchal 
endif 
C 

c  ***  Changed  to  attach  text  string  to  current  zone  -  McD 
c  TEXT= ' TEXT  X=0 . 14 , Y=0 . 9, T="CYCLE  ' //ACYCLE// ' ,  TIME  ' / /ATIM/ / ' 

S'" 

WRITE (31,*)  'TITLE  =  "  DYNA_N  -  VERSION  ',VS,'  ' , DAT , '  "' 

WRITE (31,*)  VARCHAR 
c  WRITE (31,*)  TEXT 

write (31, 203)  .izone, ncycle, tt 
IF  (  NUMELB  +  NUMELS  .EQ.  NEV)  THEN 
IF  (NUMELS  .GE.  1)  WRITE ( 31 , 201 )  NKN,  NUMELS 
ELSE 

WRITE (31, 202)  NKN,  NUMELH 
ENDIF 

201  FORMAT (IX, 'ZONE  F=FEPOINT,  N=',I7,’,  E=',I7,',  ET=QUADRILATERAL ' ) 

202  FORMAT (IX, 'ZONE  F=FEPOINT,  N=',I7,',  E=',I7,',  ET=BRICK' ) 

203  format (lx, ' TEXT  X=0 . 14 , Y=0 . 9, ZN=' , i6, ' ,  T="CYCLE  ',i6,',  TIME  ', 

1  E14.5,  '  SEC’") 

C 

C  Knotenkoordinaten,  +  evtl.  Displacements  und  Velocities 
C 

DO  4711  K  =  1 , NKN 

IF  (NDISP  .GE.  1  .AND.  NVELO  . GE .  1) 

1  WRITE ( 31, ' (9(1X,E12.5)) ') 

2  sngl (X (1, K) ) ,  sngl (X (2, K) ) ,  sngl (X (3, K) ) , 

3  sngl (X (1, K) -X0 (1, K) ) ,  sngl (X (2, K) -X0 (2, K) ) , 

4  sngl (X (3, K) -X0 (3,  K) )  , 

5  sngl (V(1,K) ) ,  sngl (V(2, K) ) ,  sngl(V(3,K)) 
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IF  (NDISP  .  GE .  1  .AND..  NVELO  .LT.  1) 

1  WRITE (31, ' ( 6 ( IX, E12 . 5 ) ) ') 

2  sngl (X (1, K) ) ,  sngl (X (2, K) ) ,  Sngl (X (3, K) ) , 

3  sngl (X ( 1, K) -X0 ( 1, K) ) ,  sngl (X (2, K) -X0 (2, K) ) , 

4  sngl (X (3, K) -X0 (3,  K) ) 

IF  (NDISP  .LT.  1  .AND.  NVELO  .GE.  1) 

1  WRITE (31, ' (6(1X,E12.5) ) ') 

2  sngl (X  ( 1,  K)  )  ,  sngl (X (2,  K)  )  ,  sngl (X (3,  K)  )  , 

3  sngl (V(l,  K)  ) ,  sngl (V (2,  K)  ) ,  sngl(V(3,K)) 

IF  (NDISP  .LT.  1  .AND.  NVELO  .LT.  1) 

1  WRITE (31, ' (3(1X,E12.5)) ') 

2  sngl (X(1,K) ) ,  sngl (X (2, K) ) ,  sngl(X(3,K)) 

4711  CONTINUE 
C 

C  ELEMENTCONNECTIVITY  aufgeteilt  in  ZONES  (je  EL-TYP  eine  ZONE) 

C 

IF  (  NUMELH  .GE.  1  )  THEN 
IZO  =  IZO'+  1 
DO  4712  N=l, NUMELH 
l=nhxpnt(n) 

WRITE (31,  '  (818) ' )  (ixh (i, 1) ,i=2, 9) 

4712  CONTINUE 
ENDIF 

IEL  =  NUMELH  +  NUMELB 
C 

IF  (NUMELS  .GE.  1)  THEN 
C 

IF  ( IZO . GE . 1 .AND . IDUP . EQ. 1)  WRITE (31, 401)  NKN,  NUMELS 
IF  (IZO . GE . 1 .AND . IDUP . EQ . 2 )  WRITE (31, 402)  NKN,  NUMELS 
IF  ( IZO . GE . 1 .AND . IDUP . EQ. 3)  WRITE (31, 403)  NKN,  NUMELS 

401  FORMAT  (IX,  'ZONE  F=FEPOINT,  N=',I7,\  E=',I7, 

1  ',  ET=QUADRILATERAL , D= ( 1 , 2 , 3 )  ' ) 

402  FORMAT (IX, 'ZONE  F=FEPOINT,  N=',I7,',  E=',I7, 

F  ',  ET=QUADRILATERAL, D= (1,2, 3, 4, 5, 6) ’) 

403  FORMAT (IX, 'ZONE  F=FEPOINT,  N=',I7,',  E=',I7, 

F  ',  ET=QUADRILATERAL, D= (1,2, 3, 4, 5, 6, 7, 8, 9)  ') 

DO  4713  N=l, NUMELS 
IEL  =  IEL  +1 
l=nshpnt(n) 

if  (ixs (4, 1) . eq. ixs (5, 1) ) then 

write(31,  '  (418) ')  (ixs(i,l),  i=2,4),0 
else 

WRITE(31,  '  (418)  ' )  (ixs (i, 1) ,  i=2,5) 
endif 

4713  CONTINUE 
ENDIF 

C 

IEL  =  NUMELH  +  NUMELB  +  NUMELS 
IF  (NUMELT  .GE.  1)  THEN 
DO  4714  N=l, NUMELT 
IEL  =  IEL  +1 
l=ntxpnt(n) 

WRITE (31,  '  (818)  ')  (ixt (i, 1) ,i=2,9) 

4714  CONTINUE 
ENDIF 

CLOSE  (UNIT=31) 

C 

RETURN 

END 
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APPENDIX  D.  DOCUMENTATION  PAGE  FOR  NEW  MATERIAL  TYPE 


Material  Type  44  Elastic-Plastic  with  Void  Growth  and  Nucleation 


Columns 


Quantity 


Format 


Card  3 

I- 10  Young's  Modulus  (E)  El 0.0 

II- 20  Poisson's  Ratio  (v)  E10.0 

21-30  Initial  Porosity/Void  Content  (<I>0)  E10.0 

3 1  -40  Initial  Yield  Stress  (Syp)  E 1 0.0 

Card  4 

Constants  for  Gurson's  Void  Model  ' 

I- 10  q,  (Default  =1.5)  El 0.0 

II- 20  qb  (Default  =  1.0)  El  0.0 

21-30  q3  (Default  =  q,2)  E10.0 

Constants  for  Void  Nucleation  Model 

3 1  -40  Void  Nucleation  Particle  Content  (fN)  (Default  =  0.0)  E 1 0.0 

41-50  Mean  Nucleating  Strain  (e^  (Default  =  0.0)  E10.0 

51-60  Nucleating  Strain  Standard  Deviation  (sN)  (Default  =  0.0)  E10.0 

61-70  Number  of  Strain-Hardening  Line  Segments  Defined  (iseg)  E10.0 

Card  5 

Upper  Strain  Points  of  Line  Segments 

I- 10  End  Point  of  1st  segment  (s,)  E10.0 

II- 20  e2  El  0.0 

21-30  83  E10.0 

31-40  84  E10.0 

41-50  8S  E10.0 

51-60  e6  E10.0 

61-70  87  E10.0 

71-80  Sg  E10.0 

Card  6 

Upper  Strain  Points  of  Line  Segments,  Part  2 

I- 10  89  E10.0 

II- 20  810  E10.0 

21-30  e„  E10.0 

31-40  e,2  E10.0 

41-50  8,3  E10.0 

51-60  sM  E10.0 

61-70  e,5  E10.0 

71-80  8,5  E10.0 
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Stress 


Card  7 

Stress  End-points  of  Line  Segments 


1-10 

Stress  at  End  Point  of  1st  segment  (c,) 

E10.0 

11-20 

ct2 

E10.0 

21-30 

<*3 

E10.0 

31-40 

a, 

E10.0 

41-50 

<*S 

E10.0 

51-60 

<*6 

E10.0 

61-70 

ct7 

E10.0 

71-80 

<*s 

E10.0 

Card  8 

Upper  Strain  Points  of  Line  Segments,  Part  2 

1-10 

a, 

E10.0 

11-20 

<*10 

E10.0 

21-30 

<*u 

E10.0 

31-40 

E10.0 

41-50 

<*13 

E10.0 

51-60 

cr,4 

E10.0 

61-70 

<*15 

E10.0 

71-80 

<*16 

E10.0 

As  shown  in  the  figure  above,  the  stress  and  strain  values  are  taken  directly  from  standard  tensile 
test  results  for  the  material. 
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